Reporte Técnico Trabajo Final Analítica Predictiva

Introducción.

El presente reporte técnico recopila el desarrollo del trabajo final de la asignatura Analítica Predictiva dictada por la Facultad de Minas en la Universidad Nacional de Colombia sede Medellín.

Lineamientos del Trabajo.

## Objetivo General.

Predecir los accidentes en la ciudad de Medellín, tomando como insumo los datos abiertos de movilidad, publicados por la Alcaldía de Medellín en el portal GeoMedellin.

## Entrenamiento de un modelo preditivo.

Se requiere construir un modelo de prediccion que pueda pronosticar los accidentes en la ciudad a nivel de barrio por cada clase de accidente a una periodicidad diaria, semanal y mensual

## Agrupamiento de los barrios de Medellín según su accidentalidad.

Además del modelo se exige desarrollar un agrupamiento de los barrios de Medellín de acuerdo con su accidentalidad.

## Presentación.

Los hallazgos y el modelamiento están disponibles para su uso a través de una aplicación web, la cual puede visitarse “aquí”, que cuenta además con video promocional.

Contextualización.

Medellín con 2’569.007 (proyección del DANE 2020) habitantes es la segunda ciudad más poblada de Colombia, la cual es caracterizada por ser la ciudad con mejor calidad de vida, según Ciudades Cómo Vamos; y ser la segunda ciudad en aportar más al PIB del país, al rededor de 14,38% a 2018. La fuerte industria de la ciudad se ha expandido a los municipios metropolitanos, constuyendo de esta manera, una zona del País con alto desarrollo económico.

Tomando como punto de partida la importancia de la ciudad, se espera que al ser un municipio agitado por sus condiciones económicas y sociales, por consiguiente, se tengan cifras de accidentalidad altas, por tanto resulte conveniente desarrollar un modelo de pronóstico que permita predecir la cantidad de accidentes y así llevar a cabo planes de acción que busquen mitigar al máximo la accidentalidad en la ciudad.

Geolocalización y Determinación del Espacio de Trabajo.

Como se menciona en la introducción y en el objetivo general, se trabaja con datos abiertos proporcionados por la Alcaldía de Medellín sobre el registro de accidentes en la ciudad y corregimientos aledaños.

Desarrollo del Trabajo.

Librerias usadas:

## Captura de Datos.

Para dar cumplimiento a los parámetros establecidos, se descargan las series de datos pertenecientes a los años 2014, 2015, 2016, 2017 y 2018, por consiguiente se procede a combinar todos los archivos para obtener un sólo set de datos.

urlfile <- "https://raw.githubusercontent.com/jdgallegoq/analitica_predictiva/master/accidentes3.csv"
accidentes <- read.csv(urlfile, fileEncoding = "ISO-8859-1")
#accidentes <- read.csv("D:/jhoparra/2020-1/Predictiva/analitica_predictiva/accidentes3.csv",fileEncoding = "ISO-8859-1")

El set de datos original contiene las siguientes variables:

colnames(accidentes)

##  [1] "OBJECTID"      "RADICADO"      "FECHA"         "HORA"         
##  [5] "DIA"           "PERIODO"       "CLASE"         "DIRECCION"    
##  [9] "DIRECCION_ENC" "CBML"          "TIPO_GEOCOD"   "GRAVEDAD"     
## [13] "BARRIO"        "COMUNA"        "DISENO"        "DIA_NOMBRE"   
## [17] "MES"           "MES_NOMBRE"    "X_MAGNAMED"    "Y_MAGNAMED"   
## [21] "LONGITUD"      "LATITUD"

De las cuales las más relevantes para el desarrollo de todo el trabajo son: 1. Fecha. 2. Día. 3. Periodo (Año). 4. Clase 5. Gravedad. 6. Barrio. 7. Comuna. 8. Dia Nombre. 9. Mes. 10. Mes Nombre. 11. Longitud. 12. Latitud.

las clases de accidentes descritas son las siguientes:

unique(accidentes$CLASE)

## [1] "Atropello"          "Choque"             "Otro"              
## [4] "Caida ocupante"     "Volcamiento"        "Incendio"          
## [7] "Choque y Atropello" ""

Por otra parte las gravedades de los accidentes son:

unique(accidentes$GRAVEDAD)

## [1] "MUERTO"     "SOLO DAÑOS" "HERIDO"

Preprocesamiento y Descripción.

Tomando como base las clases y las gravedades de accidentes, por año se tienen las siguientes cifras:

table(accidentes$PERIODO, accidentes$CLASE)

##       
##              Atropello Caida ocupante Choque Choque y Atropello Incendio  Otro
##   2014     0      4779           4157  27157                  0        8  4521
##   2015     1      4485           3691  28250                  0        1  4218
##   2016     5      4167           3680  28631                  0        4  4870
##   2017     0      3638           3433  29196                  1        4  4718
##   2018     0      3610           3617  28213                  0        7  3739
##       
##        Volcamiento
##   2014         972
##   2015        1435
##   2016        1484
##   2017        1572
##   2018        1174

table(accidentes$PERIODO, accidentes$GRAVEDAD)

##       
##        HERIDO MUERTO SOLO DAÑOS
##   2014  23077    256      18261
##   2015  23274    250      18557
##   2016  23994    235      18612
##   2017  22865    226      19471
##   2018  20991    297      19072

El siguiente gráfico de barras apiladas permitirá diferenciar de manera visual las frecuencias de cada gravedad por año.

acc_fig1 <- accidentes[, c("PERIODO", "CLASE", "GRAVEDAD")]
tabla <- table(acc_fig1$PERIODO, acc_fig1$GRAVEDAD)
acc_fig1 <- as.data.frame.matrix(tabla)
colnames(acc_fig1) <- c("herido", "muerto", "solo_danos")
fig1 <- plot_ly(acc_fig1, x = ~unique(accidentes$PERIODO),
                y = ~herido, type = 'bar', name = 'Herido', text = acc_fig1$herido,
                textposition = 'outside',
                marker = list(line = list('rgb(105,105.105)')))
fig1 <- fig1 %>% add_trace(y = ~solo_danos, name = 'Solo Daños', text = acc_fig1$solo_danos,
                           textposition = 'outside',
                           marker = list(line = list('rgb(105,105.105)')))
fig1 <- fig1 %>% add_trace(y= ~muerto, name = 'Muertos', text = acc_fig1$muerto,
                           textposition = 'outside',
                           marker = list(line = list('rgb(105,105.105)')))
fig1 <- fig1 %>% layout(title = "Accidentes por Clase y Año",
                        yaxis = list(title = 'Accidentes'),
                        xaxis = list(title = 'Año'),
                        barmode = 'stack')
fig1

## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

Se puede percibir que el año 2016 ha sido el año con mayor accidentalidad entre 2014 y 2018, sin embargo, los accidentes mortales no son percibibles en las barras apiladas dada la diferencia de frencuencias con las otras gravedades; por esta razón se exponen únicamente los accidentes mortales en el siguiente gráfico:

fig2 <- plot_ly(acc_fig1, x = ~unique(accidentes$PERIODO),
                y = ~muerto, type = 'bar', name = 'Accidentes Fatales',
                text = acc_fig1$muerto, textposition = 'outside',
                 marker = list(line = list('rgb(105,105.105)')))
fig2 <- fig2 %>% layout(title = "Accidentes Fatales por año",
                        yaxis = list(title = 'Acc'),
                        xaxis = list(title = 'Año'),
                        barmode = 'stack')
fig2

Aunque el gráfico de barras apiladas mostraba al año 2014 como el año con menos accidentalidad, el año 2014 fue año con mayor cantidad de accidentes fatales.

Después de haber graficado las frecuencias de accidentes por año, la siguiente serie de tiempo expone la evolución de los accidentes por mes, comparando por lineas cada año de resgistros:

acc_fig3 <- as.data.frame(as.Date(accidentes[, "FECHA"], format = "%Y-%m-%d"))
colnames(acc_fig3) <- "FECHA"
acc_fig3$MES <- strftime(acc_fig3$FECHA, format = "%m")
acc_fig3$ANO <- strftime(acc_fig3$FECHA, format = "%Y")
acc_fig3 <- as.data.frame.matrix(table(mes = acc_fig3$MES, ano = acc_fig3$ANO))
acc_fig3$MES <- row.names(acc_fig3)
fig3 <- plot_ly(acc_fig3, x = ~MES, y = ~acc_fig3$`2018`, name = '2018',
                type = 'scatter', mode = 'lines',
                line = list(color = 'rgb(205, 12, 24)', width = 4))
fig3 <- fig3 %>% add_trace(y = ~acc_fig3$`2017`, name = '2017', line = list(color = 'rgb(22, 96, 167)', width = 4)) 
fig3 <- fig3 %>% add_trace(y = ~acc_fig3$`2016`, name = '2016', line = list(color = 'rgb(205, 12, 24)', width = 4, dash = 'dash'))
fig3 <- fig3 %>% add_trace(y = ~acc_fig3$`2015`, name = '2015', line = list(color = 'rgb(22, 96, 167)', width = 4, dash = 'dot'))
fig3 <- fig3 %>% add_trace(y = ~acc_fig3$`2014`, name = '2014', line = list(color = 'rgb(205, 12, 24)', width = 4, dash = 'dot'))
fig3 <- fig3 %>% layout(title = "Accidentes por Mes",
         xaxis = list(title = "Meses"),
         yaxis = list (title = "Accidentes"))
fig3

A partir de la serie de tiempo graficada se pueden comentar las siguientes ideas: 1. Los cuatro años concuerdan en que el mes con menos accidentes es Enero. Es un mes “de reposo” despues de las festividades de Fin de Año. 2. Los accidentes en el mes de marzo fueron disminuyendo año tras año. la direfencia es considerable al pasar en 2014 de 3855 accidentes a 3335 accidentes el 2018. 3.Se presenta el mismo pico en el mes Mayo en 3 de los 4 años; siendo por año, uno de los meses con mayor accidentalidad. 4. 3 de los 4 años, concuerdan en que Agosto es el mes con mayor accidentalidad del año.

Estos comportamientos pueden darse dado fechas especiales de cada mes con alta frecuencia de accidentes; por ejemplo en marzo el día de la mujer; en mayo el día de la madre, en agosto la feria de flores.

Con base en lo anterior, se hará una ampliación sobre la siguiente medida de tiempo, los días por mes. Con base en lo anterior, se hará una ampliación sobre la siguiente medida de tiempo, los días por mes. De esta mandera el siguiente mapa de calor mostrará cuáles son los días por mes que mayor accidentalidad presentan.

acc_fig4 <- as.data.frame(as.Date(accidentes[, "FECHA"], format = "%Y-%m-%d"))
colnames(acc_fig4) <- "FECHA"
acc_fig4$MES <- strftime(acc_fig4$FECHA, format = "%B")
acc_fig4$MES <- factor(acc_fig4$MES, levels = c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre"))
acc_fig4$DIA <- strftime(acc_fig4$FECHA, format = "%A")
acc_fig4$DIA <- factor(acc_fig4$DIA, levels = c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo"))
acc_fig4m <- as.matrix(table(acc_fig4$MES, acc_fig4$DIA))
acc_fig4m <- apply(acc_fig4m, 2, function(x){x/mean(x)})
fig5 <- plot_ly(x=colnames(acc_fig4m), y=rownames(acc_fig4m),
                showscale = F,
                z = acc_fig4m,
                colors = colorRamp(c("lightgoldenrod1", "indianred2")),
                type = "heatmap")
fig5

La gráfica de calor muestra que los días viernes y jueves en los meses agosto y septiembre son los días con mayor accidentalidad en los 4 años considerados y que los días con menos accidentalidad son los lunes, específicamente en los meses enero, junio y noviembre; sin embargo el día que por mes tiene más accidentalidad es el sábado.

Habiendo visto de manera gráfica como se comportan las frecuencias de los accidentes, se procede a depurar y limpiar la base de datos con el objetivo de encontrar nuevas variables entre las relaciones de las existentes; además se continúa con la sección de agrupamiento.

## Agrupamiento

table(accidentes$GRAVEDAD)

## 
##     HERIDO     MUERTO SOLO DAÑOS 
##     114201       1264      93973

table(accidentes$CLASE)

## 
##                             Atropello     Caida ocupante             Choque 
##                  6              20679              18578             141447 
## Choque y Atropello           Incendio               Otro        Volcamiento 
##                  1                 24              22066               6637

Dado que la clase del accidente puede proveer estadísticas importantes para realizar el agrupamiento de barrios se procede a unificar para tener categorías con una cantidad importante de registros. Por esta razón, las categorías vacías e Incendio serán agregadas a la categoría Otro, por otro lado, La categoría Choque y Atropello se agregará a los datos de la categoría Choque.

accidentes <- accidentes %>%
  rename(BARRIO_1 = BARRIO)
accidentes$CLASE <- gsub("Incendio","Otro",accidentes$CLASE)
accidentes$CLASE <- gsub("Choque y Atropello","Choque",accidentes$CLASE)
accidentes$CLASE[accidentes$CLASE == ""] <- "Otro"
table(accidentes$CLASE)

## 
##      Atropello Caida ocupante         Choque           Otro    Volcamiento 
##          20679          18578         141448          22096           6637

Con esta información es necesario idear algunos indicadores que más allá de sus valores aporten información y sean útiles para la intervención de la accidentalidad. En un principio se pueden establecer indicadores para cada una de las categorías de la clase de accidente así como la gravedad de los mismos y la población de cada barrio.

Hasta el momento los indicadores definidos para el agrupamiento son:

1. Accidentes con atropello.

1. Heridos.
2. Muertos.
3. Solo daños.

2. Accidente de choque.

1. Heridos.
2. Muertos.
3. Solo daños.

3. Accidente de caida ocupante.

1. Heridos.
2. Muertos.
3. Solo daños.

4. Accidente de volcamiento.

1. Heridos.
2. Muertos.
3. Solo daños.

5. Otro tipo de accidentes.

1. Heridos.
2. Muertos.
3. Solo daños.

Ya que existen algunos datos faltantes para el tema de los barrios se procede a asignarle su respectivo barrio de acuerdo a sus coordenadas. Para se importa el archivo geoJson. que contiene los polígonos de los barrios de Medellín. Este procedimiento es igualmente válido para poder graficar el mapa adecuadamente con los resultados del clustering.

Sys.setlocale(locale = "Spanish")

## [1] "LC_COLLATE=Spanish_Spain.1252;LC_CTYPE=Spanish_Spain.1252;LC_MONETARY=Spanish_Spain.1252;LC_NUMERIC=C;LC_TIME=Spanish_Spain.1252"

barrios_medellin <- readOGR("G:/Mi unidad/UNIVERSIDAD/ESPECIALIZACION/Analítica Predictiva/TRABAJO/analitica_predictiva/Agrupamiento/Limite_Barrio_Vereda_Catastral.geojson",
                            stringsAsFactors = FALSE,use_iconv = TRUE,encoding = "UTF-8")

## OGR data source with driver: GeoJSON 
## Source: "G:\Mi unidad\UNIVERSIDAD\ESPECIALIZACION\Analítica Predictiva\TRABAJO\analitica_predictiva\Agrupamiento\Limite_Barrio_Vereda_Catastral.geojson", layer: "Limite_Barrio_Vereda_Catastral"
## with 354 features
## It has 8 fields

Para realizar este proceso es necesario que los puntos provenientes de la accidentalidad se encuentren en la misma proyección de los polígonos.

accidentes_spatial <- accidentes
coordinates(accidentes_spatial) <- ~LONGITUD+LATITUD
proj4string(accidentes_spatial) <- proj4string(barrios_medellin)

## Warning in proj4string(barrios_medellin): CRS object has comment, which is lost
## in output

Ahora se llama la función over de la librería sp para determinar los poligonos en los que se encuentra cada punto, este proceso ayudará a declarar los nombres de los barrios de una manera estándar para generar el mapa.

## Código para determinar en cuáles barrios se encuentran los puntos
contains_barrio <- over(accidentes_spatial, barrios_medellin)

De esta manera, ahora se añade la información del archivo geojson al data frame para poder identificar los puntos que se encuentran sin barrio.

accidentes <- cbind(accidentes,contains_barrio)

Se someterá el set de datos a una búsqueda de datos faltantes:

table(is.na(accidentes$NOMBRE_BARRIO))

## 
##  FALSE   TRUE 
## 208923    515

Siguen existiendo 515 registros sin un barrio asignado, los cuales se apartan del set de datos base.

accidentes_na <- accidentes[is.na(accidentes$NOMBRE_BARRIO),]

Después de analizar los datos faltantes, se puede observar que estos registros se encuentran por fuera de la región considera Medellín de acuerdo a las delimitaciones encontradas en el archivo geojson, por esta razón se eliminarán del conjunto de datos.

accidentes <- accidentes[!is.na(accidentes$NOMBRE_BARRIO),]
table(is.na(accidentes$NOMBRE_BARRIO))

## 
##  FALSE 
## 208923

Ahora con estos datos podemos proceder a realizar mapas y hacer el análisis por clustering. Para comenzar se ilustrará un ejemplo simple con el número total de accidentes.

## Obtener indicador de cantidad de accidentes por barrio en total
barrios_ejemplo <- accidentes %>%
  select(NOMBRE_BARRIO) %>%
  group_by(NOMBRE_BARRIO) %>%
  summarize(conteo = n())

## `summarise()` ungrouping output (override with `.groups` argument)

head(barrios_ejemplo)

## # A tibble: 6 x 2
##   NOMBRE_BARRIO        conteo
##   <chr>                 <int>
## 1 Aguas Frias              63
## 2 Aldea Pablo VI           36
## 3 Alejandría              428
## 4 Alejandro Echavarría    773
## 5 Alfonso López          1239
## 6 Altamira                720

## Copia del spatial data frame
barrios_med_ejemplo <- barrios_medellin

## Sacar index para organizar luego los registros
barrios_med_ejemplo@data$index <- as.integer(row.names(barrios_med_ejemplo@data))

## Combinar el indicador con el data frame spatial para graficar en mapa
barrios_med_ejemplo@data <- merge(barrios_med_ejemplo@data,barrios_ejemplo,by = "NOMBRE_BARRIO",all.x=TRUE)
barrios_med_ejemplo@data <- barrios_med_ejemplo@data %>% arrange(index)
barrios_med_ejemplo@data$conteo[is.na(barrios_med_ejemplo@data$conteo)] <- 0

Mapa

labels <- sprintf(
  "<strong>%s</strong><br/>%g accidentes en total",
  barrios_med_ejemplo@data$NOMBRE_BARRIO, barrios_med_ejemplo@data$conteo
) %>% lapply(htmltools::HTML)

pal <- colorNumeric("YlOrRd", NULL)

leaflet(barrios_med_ejemplo)%>% 
  addTiles()  %>% 
  setView(lat=6.247612, lng=-75.582932, zoom=11.5) %>%
  addPolygons(color="grey",weight = 1, fillOpacity = 0.75,opacity = 1, smoothFactor = 0.7, fillColor = ~pal(conteo),
  highlight = highlightOptions(
    weight = 3,
    color = "#666",
    fillOpacity = 0.8,
    bringToFront = TRUE),
  label = labels,
  labelOptions = labelOptions(
    style = list("font-weight" = "normal", padding = "3px 8px"),
    textsize = "15px",
    direction = "auto")) %>% 
  addLegend(pal = pal, values = ~conteo, opacity = 0.7, title = "Cant. accidentes",
            position = "topright")

El mapa proyectado se toma como base para la aplicación de Shiny, además se toma como punto de partida para el clustering que se desarrolla en esta sección. Gráficamente, el mapa permite observar la mayor cantidad de accidentes ocurren en barrios cercanos a las vías principales de la ciudad y en la vía de mayor flujo y con mayor límite de velocidad: la autopista regional.

Agrupamiento con enfoque de variables de conteo

El primer enfoque que se aborda es usando las variables con el conteo de cada indicador definido en la sección anterior, por lo cual los datos de cada barrio estarán en distintas escalas, es decir, los barrios que tengan más flujo vehicular pueden tener mayor cantidad de accidentes comparados con barrios con pocas vías o poco flujo vehicular.

## Miramos la cantidad de accidentes por combinación de barrio, gravedad y clase de accidente
barrios_conteo <- accidentes %>%
  select(NOMBRE_BARRIO,GRAVEDAD,CLASE) %>%
  group_by(NOMBRE_BARRIO,GRAVEDAD,CLASE) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO', 'GRAVEDAD' (override with `.groups` argument)

head(barrios_conteo)

## # A tibble: 6 x 4
## # Groups:   NOMBRE_BARRIO, GRAVEDAD [2]
##   NOMBRE_BARRIO GRAVEDAD   CLASE          conteo
##   <chr>         <chr>      <chr>           <int>
## 1 Aguas Frias   HERIDO     Atropello          16
## 2 Aguas Frias   HERIDO     Caida ocupante     11
## 3 Aguas Frias   HERIDO     Choque             11
## 4 Aguas Frias   HERIDO     Otro               12
## 5 Aguas Frias   HERIDO     Volcamiento         3
## 6 Aguas Frias   SOLO DAÑOS Choque             10

## Ahora convertimos este data frame de formato narrow a formato wide
barrios_conteo <- barrios_conteo %>%
  mutate(indicador = paste(CLASE,GRAVEDAD,sep="_"))
barrios_conteo <- barrios_conteo[,c("NOMBRE_BARRIO","indicador","conteo")]
head(barrios_conteo)

## # A tibble: 6 x 3
## # Groups:   NOMBRE_BARRIO [1]
##   NOMBRE_BARRIO indicador             conteo
##   <chr>         <chr>                  <int>
## 1 Aguas Frias   Atropello_HERIDO          16
## 2 Aguas Frias   Caida ocupante_HERIDO     11
## 3 Aguas Frias   Choque_HERIDO             11
## 4 Aguas Frias   Otro_HERIDO               12
## 5 Aguas Frias   Volcamiento_HERIDO         3
## 6 Aguas Frias   Choque_SOLO DAÑOS         10

barrios_conteo_indic <- barrios_conteo %>%
  pivot_wider(values_from="conteo",names_from="indicador",values_fill = 0)
head(barrios_conteo_indic)

## # A tibble: 6 x 14
## # Groups:   NOMBRE_BARRIO [6]
##   NOMBRE_BARRIO Atropello_HERIDO `Caida ocupante~ Choque_HERIDO Otro_HERIDO
##   <chr>                    <int>            <int>         <int>       <int>
## 1 Aguas Frias                 16               11            11          12
## 2 Aldea Pablo ~               11                6             5           3
## 3 Alejandría                  15               16            78          18
## 4 Alejandro Ec~               85               74           200         110
## 5 Alfonso López              141              188           262         191
## 6 Altamira                    47              103           184          90
## # ... with 9 more variables: Volcamiento_HERIDO <int>, `Choque_SOLO
## #   DAÑOS` <int>, `Otro_SOLO DAÑOS` <int>, Choque_MUERTO <int>,
## #   Atropello_MUERTO <int>, `Volcamiento_SOLO DAÑOS` <int>, `Caida
## #   ocupante_MUERTO` <int>, Otro_MUERTO <int>, Volcamiento_MUERTO <int>

barrios_conteo_indic <- as.data.frame(barrios_conteo_indic)
row.names(barrios_conteo_indic) <- barrios_conteo_indic$NOMBRE_BARRIO
barrios_conteo_indic <- barrios_conteo_indic[,-1]
head(barrios_conteo_indic)

##                      Atropello_HERIDO Caida ocupante_HERIDO Choque_HERIDO
## Aguas Frias                        16                    11            11
## Aldea Pablo VI                     11                     6             5
## Alejandría                         15                    16            78
## Alejandro Echavarría               85                    74           200
## Alfonso López                     141                   188           262
## Altamira                           47                   103           184
##                      Otro_HERIDO Volcamiento_HERIDO Choque_SOLO DAÑOS
## Aguas Frias                   12                  3                10
## Aldea Pablo VI                 3                  1                 9
## Alejandría                    18                  9               289
## Alejandro Echavarría         110                 46               254
## Alfonso López                191                 50               397
## Altamira                      90                 21               272
##                      Otro_SOLO DAÑOS Choque_MUERTO Atropello_MUERTO
## Aguas Frias                        0             0                0
## Aldea Pablo VI                     1             0                0
## Alejandría                         2             1                0
## Alejandro Echavarría               0             2                2
## Alfonso López                      2             3                4
## Altamira                           1             0                0
##                      Volcamiento_SOLO DAÑOS Caida ocupante_MUERTO Otro_MUERTO
## Aguas Frias                               0                     0           0
## Aldea Pablo VI                            0                     0           0
## Alejandría                                0                     0           0
## Alejandro Echavarría                      0                     0           0
## Alfonso López                             1                     0           0
## Altamira                                  0                     1           1
##                      Volcamiento_MUERTO
## Aguas Frias                           0
## Aldea Pablo VI                        0
## Alejandría                            0
## Alejandro Echavarría                  0
## Alfonso López                         0
## Altamira                              0

Con este set de datos extraído, se procede a realizar el agrupamiento jerárquico, con el fin de idear la cantidad de clústers con los cuales se ejecutará la técnica k-medias. Adicional a este último método, se usará la técnica DBSCAN para comparar los resultados obtenidos.

Primero, se escalan los datos de cada una de las variables para evitar problemas por diferencia de unidades.

## Escalar datos
barrios_centrados <- scale(barrios_conteo_indic,center = TRUE,scale = TRUE)

## Extraer datos de media y desviación estándar para poder reversar la operación más adelante
print("Media:")

## [1] "Media:"

(media <- attr(barrios_centrados,"scaled:center"))

##       Atropello_HERIDO  Caida ocupante_HERIDO          Choque_HERIDO 
##            65.00000000            59.96103896           153.78571429 
##            Otro_HERIDO     Volcamiento_HERIDO      Choque_SOLO DAÑOS 
##            70.33766234            20.84740260           302.50649351 
##        Otro_SOLO DAÑOS          Choque_MUERTO       Atropello_MUERTO 
##             1.19805195             1.79870130             2.04870130 
## Volcamiento_SOLO DAÑOS  Caida ocupante_MUERTO            Otro_MUERTO 
##             0.61363636             0.19480519             0.01948052 
##     Volcamiento_MUERTO 
##             0.00974026

print("Desviación estándar:")

## [1] "Desviación estándar:"

(desv_est <- attr(barrios_centrados,"scaled:scale"))

##       Atropello_HERIDO  Caida ocupante_HERIDO          Choque_HERIDO 
##            80.93158731            64.38568469           188.88751851 
##            Otro_HERIDO     Volcamiento_HERIDO      Choque_SOLO DAÑOS 
##            77.70592864            23.19341055           459.19849798 
##        Otro_SOLO DAÑOS          Choque_MUERTO       Atropello_MUERTO 
##             1.79296384             2.60887953             3.64475862 
## Volcamiento_SOLO DAÑOS  Caida ocupante_MUERTO            Otro_MUERTO 
##             1.09637057             0.48532768             0.13843138 
##     Volcamiento_MUERTO 
##             0.09837075

Se puede concluir con base al escalamiento que los indicadores de algunas clases de accidente-gravedad no aportan mucha variabilidad en el conjunto de variables, por esta razón no podrían tener mucha influencia en el comportamiento de los clústers.

Agrupamiento Jerárquico

## Primero se computa la matriz de dissimilaridad
d <- dist(barrios_centrados, method = "euclidean")

## Usamos complete linkage como métrica entre clústers
hc1 <- hclust(d, method = "complete" )

## Dendograma
plot(hc1, cex = 0.6, hang = -1)

Por medio de esta grpafica se puede intuir que existir unos cuatro clústers en el agrupamiento por barrios. Para comprobar esto, se usarán distintas métricas, como slihoutte y el indíce de Dunn, con el fin de determinar qué tan bien conformados están los clústers. Por otro lado, se hace uso de una grilla de posibles valores para el desarrollo de la técnica k-medias.

K-Medias

kmeans_barrios <- kmeans(barrios_centrados,4)
clusters_barrios <- scale(kmeans_barrios$centers,center=FALSE,scale=1/desv_est)
clusters_barrios <- scale(clusters_barrios,center = (-media),scale = FALSE)
print(clusters_barrios)

##   Atropello_HERIDO Caida ocupante_HERIDO Choque_HERIDO Otro_HERIDO
## 1        248.85714             217.00000     681.23810   277.09524
## 2        101.09302             113.18605     288.65116   130.20930
## 3         76.14433              69.23711     162.05155    78.86598
## 4         20.82313              15.83673      33.53061    17.65986
##   Volcamiento_HERIDO Choque_SOLO DAÑOS Otro_SOLO DAÑOS Choque_MUERTO
## 1          83.952381        1618.09524       5.2857143     7.7619048
## 2          38.837209         525.20930       2.4186047     3.7441860
## 3          22.742268         285.48454       1.2989691     1.5773196
## 4           5.319728          60.65306       0.1904762     0.5238095
##   Atropello_MUERTO Volcamiento_SOLO DAÑOS Caida ocupante_MUERTO   Otro_MUERTO
## 1       12.0952381              2.4761905            0.61904762  4.761905e-02
## 2        3.0000000              1.5116279            0.65116279  1.162791e-01
## 3        1.9072165              0.5463918            0.11340206  2.775558e-17
## 4        0.4285714              0.1292517            0.05442177 -1.040834e-17
##   Volcamiento_MUERTO
## 1       4.761905e-02
## 2      -6.938894e-18
## 3       2.061856e-02
## 4       2.602085e-17
## attr(,"scaled:scale")
##       Atropello_HERIDO  Caida ocupante_HERIDO          Choque_HERIDO 
##            0.012356115            0.015531403            0.005294156 
##            Otro_HERIDO     Volcamiento_HERIDO      Choque_SOLO DAÑOS 
##            0.012869031            0.043115694            0.002177707 
##        Otro_SOLO DAÑOS          Choque_MUERTO       Atropello_MUERTO 
##            0.557735733            0.383306316            0.274366592 
## Volcamiento_SOLO DAÑOS  Caida ocupante_MUERTO            Otro_MUERTO 
##            0.912100367            2.060463554            7.223795606 
##     Volcamiento_MUERTO 
##           10.165622987 
## attr(,"scaled:center")
##       Atropello_HERIDO  Caida ocupante_HERIDO          Choque_HERIDO 
##           -65.00000000           -59.96103896          -153.78571429 
##            Otro_HERIDO     Volcamiento_HERIDO      Choque_SOLO DAÑOS 
##           -70.33766234           -20.84740260          -302.50649351 
##        Otro_SOLO DAÑOS          Choque_MUERTO       Atropello_MUERTO 
##            -1.19805195            -1.79870130            -2.04870130 
## Volcamiento_SOLO DAÑOS  Caida ocupante_MUERTO            Otro_MUERTO 
##            -0.61363636            -0.19480519            -0.01948052 
##     Volcamiento_MUERTO 
##            -0.00974026

De acuerdo con los resultados arrojados, se interpreta: - El clúster 3 y 4 tienden a tener un comportamiento similar en sus centroides, por tanto, la mejor opción sería agrupar tres clústers en el cual estos dos grupos se dejen en un único grupo. - Por otra parte, el grupo 1 presenta una alta tasa en todas las estadísticas, es decir es el grupo de barrios que tienen mayor cantidad de heridos y muertos en choques y atropellos. - En tanto el grupo 2 tiene las estadísticas más bajas de los grupos conformados por esta técnica.

Para poder determinar el mejor número de clústers a utilizar utilizaremos el índice de Dunn, que mide el ratio de la distancia más pequeña de observaciones de diferentes grupos contra la distancia más grande encontrada en un sólo cluster. Este valor va de 0 a infinito y valores más grandes indican una mejor separación.

dunn(clusters = kmeans_barrios$cluster, Data = barrios_centrados, method = "euclidean")

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.0281186

A pesar de que el código arroja un mensaje de advertencia no existe una influencia en la computación de la métrica de acuerdo a una investigación y comparación de valores realizadas.

Ahora se procede a probar distintos valores de k, desde 3 hasta 25, para así poder determinar el mejor número de grupos que nos dé indicaciones de como abordar el problema de accidentalidad.

k_test <- 3:25
k_full <- lapply(k_test,FUN=function(k){
  kmeans_barrios <- kmeans(barrios_centrados,k)
  return(kmeans_barrios)
})

## Warning: did not converge in 10 iterations

## Warning: did not converge in 10 iterations

dunn_full <- sapply(k_full,FUN = function(l){
  dunn_index <- dunn(clusters = l$cluster, Data = barrios_centrados, method = "euclidean")
  return(dunn_index)
})

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

data_dunn <- data.frame(k_test,dunn_full)
fig <- plot_ly(data_dunn, x = ~k_test, y = ~dunn_full, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Indice de Dunn por cantidad de clusters")
fig

val_full <- sapply(k_full,FUN = function(l){
  value_rmse <- l$tot.withinss
  return(value_rmse)
})

data_ss <- data.frame(k_test,val_full)
fig <- plot_ly(data_ss, x = ~k_test, y = ~val_full, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Suma de error cuadrático total por cantidad de clusters")
fig

Con base en ambas gráficas se puede determinar que el número de clústers que mejor distribuye los datos en distintos grupos es 16, lo cual indica que se requiere de una gran cantidad de grupos para que la variabilidad de cada uno de los grupos sea adecuada y por lo tanto que cada centroide explique de manera adecuada las características de los barrios que conforman cada grupo.

DBSCAN

Para terminar de corroborar esta información se procede a realizar el agrupamiento de los barrios usando el algoritmo DBSCAN el cual estima los grupos tomando en cuenta la densidad de los puntos. Dicho algoritmo es capaz de detectar grupos con cualquier tipo de forma.

Este algoritmo tiene en cuenta dos parámetros principales. El primero es el radio que se utiliza para la detección de los grupos basados en la densidad. El segundo parámetro, es la cantidad de puntos que debe encontrar un punto dentro del radio definido para considerarse como un punto principal.

Para obtener estos parámetros es necesario probar distintos escenarios para encontrar la mejor agrupación posible. En el caso del número de puntos en cada clúster se prueban distintos valores entre 3 y 10; con este valor se estima el radio que se utilizará en el algoritmo con el método de la rodilla con la distancia media que se encuentra usando el algoritmo de KNN, donde k es el número de puntos (desde 3 hasta 10).

dbscan::kNNdistplot(barrios_centrados, k =  3)
abline(h = 3.1, lty = 2)

La gráfica anterior muestra que la distancia media usando 3 vecinos es un valor cercano a 3.1, por lo que se establece dicho valor como el radio y el número de puntos igual a 3.

db <- fpc::dbscan(barrios_centrados, eps = 3.1, MinPts = 3)
table(db$cluster)

## 
##   0   1   2 
##  16 287   5

print("Índice de Dunn DBSCAN")

## [1] "Índice de Dunn DBSCAN"

dunn(clusters = db$cluster, Data = barrios_centrados)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.6523172

print("Índice de Dunn K-Means")

## [1] "Índice de Dunn K-Means"

dunn(clusters = k_full[[16]]$cluster, Data = barrios_centrados)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.009039349

En este caso el modelo de agrupamiento realizado con DBSCAN arrojó 3 grupos diferentes similar a lo realizado con K-Medias (3). Además, al comparar los resultados por el índice de Dunn del mejor de los escenarios de K-Medias con los resultados de DBSCAN se encuentra que DBSCAN mejora el desempeño al maximizar este índice, lo que indica que la relación entre la menor distancia entre dos grupos diferentes y la mayor distancia intra grupo es mayor en este escenario que en el caso de k-medias.

Esto indica que los grupos de barrios puede tener formas complejas que no son fácilmente identificables por k-medias.

Dado esta información partiremos de los 3 grupos encontrados con DBSCAN para obtener el mapa del agrupamiento de los barrios por accidentalidad.

Enfoque con variables porcentuales

En este enfoque se usarán las mismas variables que en el enfoque anterior pero con la diferencia de que en este caso se calculará el porcentaje de gravedad de accidente por tipo de accidente. Es decir, un barrio cualquiera puede tener cien accidentes de choque, pero dentro de esos cien accidentes de choque cincuenta resultan con al menos una persona herida, treienta con solo daños materiales y veinte con al menos un muerto. El indicador de choque_muerto sería igual a 0.2 o 20% y así sucesivamente para cada uno de los barrios. Por la naturaleza del cálculo de los indicadores, en esta ocasión no es necesario escalar las variables porque ya todas se encontrarán en un rango de 0 a 1. Además de lo descrito, en este enfoque se agrega la variable de cantidad de accidentes totales para cada barrio. Esta variable si se transfomará con e fin de manipularla en un rango 0 a 1, y que gracias a esto no tenga un peso mayor en el cálculo de la distancia, para esto se utiliza la transformación min max.

Ya que se hará uso de los mismos indicadores se tomará como base los datos del enfoque anterior y calcularemos el total por accidente para poder estimar los porcentajes.

## Miramos la cantidad de accidentes por combinación de barrio, gravedad y clase de accidente
barrios_conteo2 <- accidentes %>%
  select(NOMBRE_BARRIO,GRAVEDAD,CLASE) %>%
  group_by(NOMBRE_BARRIO,GRAVEDAD,CLASE) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO', 'GRAVEDAD' (override with `.groups` argument)

head(barrios_conteo2)

## # A tibble: 6 x 4
## # Groups:   NOMBRE_BARRIO, GRAVEDAD [2]
##   NOMBRE_BARRIO GRAVEDAD   CLASE          conteo
##   <chr>         <chr>      <chr>           <int>
## 1 Aguas Frias   HERIDO     Atropello          16
## 2 Aguas Frias   HERIDO     Caida ocupante     11
## 3 Aguas Frias   HERIDO     Choque             11
## 4 Aguas Frias   HERIDO     Otro               12
## 5 Aguas Frias   HERIDO     Volcamiento         3
## 6 Aguas Frias   SOLO DAÑOS Choque             10

Ahora se estiman los totales por tipo de accidente para calcular los porcentajes.

barrios_conteo2_full <- accidentes %>%
  select(NOMBRE_BARRIO,CLASE) %>%
  group_by(NOMBRE_BARRIO,CLASE) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO' (override with `.groups` argument)

head(barrios_conteo2_full)

## # A tibble: 6 x 3
## # Groups:   NOMBRE_BARRIO [2]
##   NOMBRE_BARRIO  CLASE          conteo
##   <chr>          <chr>           <int>
## 1 Aguas Frias    Atropello          16
## 2 Aguas Frias    Caida ocupante     11
## 3 Aguas Frias    Choque             21
## 4 Aguas Frias    Otro               12
## 5 Aguas Frias    Volcamiento         3
## 6 Aldea Pablo VI Atropello          11

Se cruzan las dos tablas para poder estimar los porcentajes.

barrios_conteo2 <- merge(barrios_conteo2,barrios_conteo2_full,by=c("NOMBRE_BARRIO","CLASE"),all.x = TRUE)
head(barrios_conteo2)

##   NOMBRE_BARRIO          CLASE   GRAVEDAD conteo.x conteo.y
## 1   Aguas Frias      Atropello     HERIDO       16       16
## 2   Aguas Frias Caida ocupante     HERIDO       11       11
## 3   Aguas Frias         Choque     HERIDO       11       21
## 4   Aguas Frias         Choque SOLO DAÑOS       10       21
## 5   Aguas Frias           Otro     HERIDO       12       12
## 6   Aguas Frias    Volcamiento     HERIDO        3        3

barrios_conteo2$perc <- barrios_conteo2$conteo.x/barrios_conteo2$conteo.y
## Ahora convertimos este data frame de formato narrow a formato wide
barrios_conteo2 <- barrios_conteo2 %>%
  mutate(indicador = paste(CLASE,GRAVEDAD,sep="_"))
barrios_conteo2 <- barrios_conteo2[,c("NOMBRE_BARRIO","indicador","perc")]
head(barrios_conteo2)

##   NOMBRE_BARRIO             indicador      perc
## 1   Aguas Frias      Atropello_HERIDO 1.0000000
## 2   Aguas Frias Caida ocupante_HERIDO 1.0000000
## 3   Aguas Frias         Choque_HERIDO 0.5238095
## 4   Aguas Frias     Choque_SOLO DAÑOS 0.4761905
## 5   Aguas Frias           Otro_HERIDO 1.0000000
## 6   Aguas Frias    Volcamiento_HERIDO 1.0000000

Ahora se trasnforma el data frame a formato wide.

barrios_conteo_indic2 <- barrios_conteo2 %>%
  pivot_wider(values_from="perc",names_from="indicador",values_fill = 0)
head(barrios_conteo_indic2)

## # A tibble: 6 x 14
##   NOMBRE_BARRIO Atropello_HERIDO `Caida ocupante~ Choque_HERIDO `Choque_SOLO DA~
##   <chr>                    <dbl>            <dbl>         <dbl>            <dbl>
## 1 Aguas Frias              1                1             0.524            0.476
## 2 Aldea Pablo ~            1                1             0.357            0.643
## 3 Alejandría               1                1             0.212            0.785
## 4 Alejandro Ec~            0.977            1             0.439            0.557
## 5 Alfonso López            0.972            1             0.396            0.600
## 6 Altamira                 1                0.990         0.404            0.596
## # ... with 9 more variables: Otro_HERIDO <dbl>, Volcamiento_HERIDO <dbl>,
## #   `Otro_SOLO DAÑOS` <dbl>, Choque_MUERTO <dbl>, Atropello_MUERTO <dbl>,
## #   `Volcamiento_SOLO DAÑOS` <dbl>, `Caida ocupante_MUERTO` <dbl>,
## #   Otro_MUERTO <dbl>, Volcamiento_MUERTO <dbl>

Se agrega la variable con el total de accidentes por barrio.

barrio_total <- accidentes %>%
  select(NOMBRE_BARRIO) %>%
  group_by(NOMBRE_BARRIO) %>%
  summarize(total = n())

## `summarise()` ungrouping output (override with `.groups` argument)

barrios_conteo_indic2 <- merge(barrios_conteo_indic2,barrio_total,by="NOMBRE_BARRIO",all.x = TRUE)
head(barrios_conteo_indic2)

##          NOMBRE_BARRIO Atropello_HERIDO Caida ocupante_HERIDO Choque_HERIDO
## 1          Aguas Frias        1.0000000             1.0000000     0.5238095
## 2       Aldea Pablo VI        1.0000000             1.0000000     0.3571429
## 3           Alejandría        1.0000000             1.0000000     0.2119565
## 4 Alejandro Echavarría        0.9770115             1.0000000     0.4385965
## 5        Alfonso López        0.9724138             1.0000000     0.3957704
## 6             Altamira        1.0000000             0.9903846     0.4035088
##   Choque_SOLO DAÑOS Otro_HERIDO Volcamiento_HERIDO Otro_SOLO DAÑOS
## 1         0.4761905   1.0000000          1.0000000      0.00000000
## 2         0.6428571   0.7500000          1.0000000      0.25000000
## 3         0.7853261   0.9000000          1.0000000      0.10000000
## 4         0.5570175   1.0000000          1.0000000      0.00000000
## 5         0.5996979   0.9896373          0.9803922      0.01036269
## 6         0.5964912   0.9782609          1.0000000      0.01086957
##   Choque_MUERTO Atropello_MUERTO Volcamiento_SOLO DAÑOS Caida ocupante_MUERTO
## 1   0.000000000       0.00000000             0.00000000           0.000000000
## 2   0.000000000       0.00000000             0.00000000           0.000000000
## 3   0.002717391       0.00000000             0.00000000           0.000000000
## 4   0.004385965       0.02298851             0.00000000           0.000000000
## 5   0.004531722       0.02758621             0.01960784           0.000000000
## 6   0.000000000       0.00000000             0.00000000           0.009615385
##   Otro_MUERTO Volcamiento_MUERTO total
## 1  0.00000000                  0    63
## 2  0.00000000                  0    36
## 3  0.00000000                  0   428
## 4  0.00000000                  0   773
## 5  0.00000000                  0  1239
## 6  0.01086957                  0   720

Se transforma la variable del total con la transformación min max.

max_total <- max(barrios_conteo_indic2$total)
min_total <- min(barrios_conteo_indic2$total)
barrios_conteo_indic2$total <- (barrios_conteo_indic2$total - min_total)/(max_total - min_total)
row.names(barrios_conteo_indic2) <- barrios_conteo_indic2$NOMBRE_BARRIO
barrios_conteo_indic2 <- barrios_conteo_indic2[,-1]
head(barrios_conteo_indic2)

##                      Atropello_HERIDO Caida ocupante_HERIDO Choque_HERIDO
## Aguas Frias                 1.0000000             1.0000000     0.5238095
## Aldea Pablo VI              1.0000000             1.0000000     0.3571429
## Alejandría                  1.0000000             1.0000000     0.2119565
## Alejandro Echavarría        0.9770115             1.0000000     0.4385965
## Alfonso López               0.9724138             1.0000000     0.3957704
## Altamira                    1.0000000             0.9903846     0.4035088
##                      Choque_SOLO DAÑOS Otro_HERIDO Volcamiento_HERIDO
## Aguas Frias                  0.4761905   1.0000000          1.0000000
## Aldea Pablo VI               0.6428571   0.7500000          1.0000000
## Alejandría                   0.7853261   0.9000000          1.0000000
## Alejandro Echavarría         0.5570175   1.0000000          1.0000000
## Alfonso López                0.5996979   0.9896373          0.9803922
## Altamira                     0.5964912   0.9782609          1.0000000
##                      Otro_SOLO DAÑOS Choque_MUERTO Atropello_MUERTO
## Aguas Frias               0.00000000   0.000000000       0.00000000
## Aldea Pablo VI            0.25000000   0.000000000       0.00000000
## Alejandría                0.10000000   0.002717391       0.00000000
## Alejandro Echavarría      0.00000000   0.004385965       0.02298851
## Alfonso López             0.01036269   0.004531722       0.02758621
## Altamira                  0.01086957   0.000000000       0.00000000
##                      Volcamiento_SOLO DAÑOS Caida ocupante_MUERTO Otro_MUERTO
## Aguas Frias                      0.00000000           0.000000000  0.00000000
## Aldea Pablo VI                   0.00000000           0.000000000  0.00000000
## Alejandría                       0.00000000           0.000000000  0.00000000
## Alejandro Echavarría             0.00000000           0.000000000  0.00000000
## Alfonso López                    0.01960784           0.000000000  0.00000000
## Altamira                         0.00000000           0.009615385  0.01086957
##                      Volcamiento_MUERTO       total
## Aguas Frias                           0 0.012088126
## Aldea Pablo VI                        0 0.006823942
## Alejandría                            0 0.083252096
## Alejandro Echavarría                  0 0.150516670
## Alfonso López                         0 0.241372587
## Altamira                              0 0.140183272

Ahora puede procederse a realizar el mismo procedimiento que se siguió en el primer enfoque para determinar los grupos de barrios que existen con esta configuración de variables.

Hierarchical Clustering

## Primero se computa la matriz de dissimilaridad
d <- dist(barrios_conteo_indic2, method = "euclidean")

## Usamos complete linkage como métrica entre clústers
hc2 <- hclust(d, method = "complete" )

## Dendograma
plot(hc2, cex = 0.6, hang = -1)
abline(h = 1.05, lty = 2)

Con un corte del dendograma alrededor de 1.05 se obtendrían más de 10 grupos porque existen una serie de barrios que se comportan como sujetos alejados de los demás barrios. Si agruparamos estos barrios en un grupo especial tendríamos 5 grupos de barrios de acuerdo a su accidentalidad. Por consiguiente se procede a mirar como se comportarían estos 5 grupos al realizar la agrupación mediante un método de capa única.

K-Medias

kmeans_barrios2 <- kmeans(barrios_conteo_indic2,5)
clusters_barrios2 <- as.data.frame(kmeans_barrios2$centers)
clusters_barrios2$total <- (clusters_barrios2$total*(max_total - min_total)) + min_total
View(clusters_barrios2)

clusters_barrios2

##   Atropello_HERIDO Caida ocupante_HERIDO Choque_HERIDO Choque_SOLO DAÑOS
## 1        0.9774188             0.9782082     0.5324693         0.4597603
## 2        0.9750193             0.9953831     0.3792934         0.6147292
## 3        0.4565217             0.4347826     0.2366115         0.6201863
## 4        0.9405371             0.9982605     0.2522513         0.7442380
## 5        0.9527581             0.9974050     0.3151406         0.6813092
##   Otro_HERIDO Volcamiento_HERIDO Otro_SOLO DAÑOS Choque_MUERTO Atropello_MUERTO
## 1   0.9901642          0.9873748      0.00971785   0.007770369       0.02258124
## 2   0.9867270          0.9841231      0.01303200   0.005977400       0.02498068
## 3   0.5652174          0.1086957      0.00000000   0.099723948       0.06521739
## 4   0.9714112          0.9381751      0.02840461   0.003510704       0.02556455
## 5   0.9777074          0.9705111      0.02221506   0.003550224       0.04724190
##   Volcamiento_SOLO DAÑOS Caida ocupante_MUERTO  Otro_MUERTO Volcamiento_MUERTO
## 1             0.01262520           0.005398377 1.179384e-04       0.0000000000
## 2             0.01510881           0.004616949 2.409617e-04       0.0007680492
## 3             0.02173913           0.000000000 0.000000e+00       0.0000000000
## 4             0.06182486           0.001739510 1.842299e-04       0.0000000000
## 5             0.02901275           0.002594971 7.751938e-05       0.0004761905
##       total
## 1  403.2131
## 2  475.6296
## 3   13.0000
## 4  611.8136
## 5 2790.7000

En este modelo se pueden apreciar cosas interesantes en cuanto al porcentaje de gravedad por cada tipo de accidente. Por ejemplo, se puede apreciar que: - Los barrios donde existe una mayor accidentalidad en total (grupo 4) no es el grupo donde en promedio se presentan mayor cantidad de casos, los cuales, el resultado del accidente es un choque con al menos una persona herida o el grupo donde en promedio se presentan mayor número de fatalidades en choques.

Al igual que en el enfoque anterior se procede a estimar el mejor número de clústers con base en el índice de Dunn y la suma de errores cuadráticos.

k_test <- 3:25
k_full2 <- lapply(k_test,FUN=function(k){
  kmeans_barrios <- kmeans(barrios_conteo_indic2,k)
  return(kmeans_barrios)
})

dunn_full2 <- sapply(k_full2,FUN = function(l){
  dunn_index <- dunn(clusters = l$cluster, Data = barrios_conteo_indic2, method = "euclidean")
  return(dunn_index)
})

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

data_dunn2 <- data.frame(k_test,dunn_full2)
fig <- plot_ly(data_dunn2, x = ~k_test, y = ~dunn_full2, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Indice de Dunn por cantidad de clusters")
fig

val_full2 <- sapply(k_full2,FUN = function(l){
  value_rmse <- l$tot.withinss
  return(value_rmse)
})

data_ss2 <- data.frame(k_test,val_full2)
fig <- plot_ly(data_ss2, x = ~k_test, y = ~val_full2, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Suma de error cuadrático total por cantidad de clusters")
fig

De acuerdo con estas gráficas se podrían utilizar valores como 7, 9 o 10 en el caso de la suma cuadrática del error, o 3 en el caso del índice de Dunn. Para este caso intentaremos con la opción de 7 grupos.

En general se ha percibido que existen un grupo de barrios con características muy diferentes a las de los demás barrios tal.

DBSCAN

Para terminar de corroborar esta información se procede a realizar el agrupamiento de los barrios usando el algoritmo DBSCAN que estima los grupos tomando en cuenta la densidad de los puntos. Dicho algoritmo es capaz de detectar grupos con cualquier tipo de forma.

Primero se procede a estimar el radio y el número mínimo de puntos para utilizar el algoritmo.

dbscan::kNNdistplot(barrios_conteo_indic2, k = 4)
abline(h = 0.26, lty = 2)

Después de realizar varias pruebas con los valores para los parámetros de DBSCAN, se encuentra que podría utilizarse un radio de distancia de 0.26 y con una cantidad mínima de 4 puntos para que un punto dado se considere como un punto central. A continuación, se prueba la agrupación con DBSCAN:

db2 <- fpc::dbscan(barrios_conteo_indic2, eps = 0.26, MinPts = 4)
table(db2$cluster)

## 
##   0   1   2 
##  23 280   5

Al igual que con el caso de DBSCAN para las variables de conteo se encuentra que en este caso también se estiman 3 grupos diferentes para la accidentalidad en los barrios de Medellín. Ahora se calcula el índice de Dunn para comparar el desempeño de este modelo con el de K-Means.

print("Índice de Dunn DBSCAN")

## [1] "Índice de Dunn DBSCAN"

dunn(clusters = db2$cluster, Data = barrios_conteo_indic2)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.6024686

print("Índice de Dunn K-Means")

## [1] "Índice de Dunn K-Means"

dunn(clusters = k_full2[[7]]$cluster, Data = barrios_conteo_indic2)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.01033676

Al comparar los resultados del índice de Dunn de los dos casos se ecnuentra que: - Al igual que en el enfoque con variables de conteo, el agrupamiento realizado por medio de DBSCAN mejora el desempeño presentado por K-Medias. Lo cual refuerza la idea de utilizar un método que no dependa en grupos con formas aproximadamentes circulares o elipsoidales.

Mirando los dos enfoques utilizado, el primer enfoque eliminando algunas variables que no aportan variabilidad al conjunto de datos y adicionando algunas variables del segundo enfoque como tasas de mortalidad en los principales accidentes para poder realizar la agrupación. Así mismo se incluirán variables de población para ver si tienen algún efecto en la forma de la agrupación.

Primer enfoque depurado con variables adicionales

De acuerdo a lo mencionado en el parráfo anterior, en este enfoque se utilizará como base la información del primer enfoque con la excepción de añadir variables relacionadas con tasas de mortalidad o de heridos en los principales indicadores, y otra variable como la población en cada uno de los barrios. Además en el primer enfoque se usa el total de accidentes en los 5 años analizados en cada barrio, lo cual puede sesgar un poco la forma de generación de los agrupamientos. Por esta razón, se utiliza el promedio de accidentalidad y de tasas por cada uno de los años, con el objetivo de que los datos no se vean influenciados por un año con un año con comportamiento anormal sino que sea la tendencia central del comportamiento por barrio.

Primero, se estiman los indicadores.

barrios_year <- accidentes %>%
  select(NOMBRE_BARRIO,PERIODO,CLASE,GRAVEDAD) %>%
  group_by(NOMBRE_BARRIO,PERIODO,CLASE,GRAVEDAD) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO', 'PERIODO', 'CLASE' (override with `.groups` argument)

head(barrios_year)

## # A tibble: 6 x 5
## # Groups:   NOMBRE_BARRIO, PERIODO, CLASE [6]
##   NOMBRE_BARRIO PERIODO CLASE          GRAVEDAD conteo
##   <chr>           <int> <chr>          <chr>     <int>
## 1 Aguas Frias      2014 Atropello      HERIDO        6
## 2 Aguas Frias      2014 Caida ocupante HERIDO        5
## 3 Aguas Frias      2014 Choque         HERIDO        6
## 4 Aguas Frias      2014 Otro           HERIDO        4
## 5 Aguas Frias      2014 Volcamiento    HERIDO        1
## 6 Aguas Frias      2015 Atropello      HERIDO        4

Ahora se calcula el promedio por año.

barrios_year_full <- barrios_year %>%
  group_by(NOMBRE_BARRIO,CLASE,GRAVEDAD) %>%
  summarize(conteo_mean = mean(conteo))

## `summarise()` regrouping output by 'NOMBRE_BARRIO', 'CLASE' (override with `.groups` argument)

head(barrios_year_full)

## # A tibble: 6 x 4
## # Groups:   NOMBRE_BARRIO, CLASE [5]
##   NOMBRE_BARRIO CLASE          GRAVEDAD   conteo_mean
##   <chr>         <chr>          <chr>            <dbl>
## 1 Aguas Frias   Atropello      HERIDO            3.2 
## 2 Aguas Frias   Caida ocupante HERIDO            2.2 
## 3 Aguas Frias   Choque         HERIDO            3.67
## 4 Aguas Frias   Choque         SOLO DAÑOS        2.5 
## 5 Aguas Frias   Otro           HERIDO            2.4 
## 6 Aguas Frias   Volcamiento    HERIDO            1

Habiendo calculado la información del promedio de accidentes en clase y gravedad para cada barrio por todos los años, se procede a llevar esta tabla al formato wide y allí sacar los indicadores que no encontramos relevantes para el estudio. Para empezar sacaremos todos los accidentes que dicen otros, ya que al ser una categoría tan ambigua es difícil determinar cual sería el plan de acción donde ocurran muchos accidentes de este estilo, porque en realidad no se tiene conocimiento sobre que tipo de accidentes son. Así mismo, se exluyen aquellos que cuya clase es volcamiento y caída ocupante, ya que también es difícil preveer un accidente de este estilo y que medidas podrían contrarrestarlo.

barrios_year_full <- barrios_year_full %>%
  filter(CLASE %in% c("Atropello","Choque"))
barrios_year_full2 <- barrios_year_full
head(barrios_year_full)

## # A tibble: 6 x 4
## # Groups:   NOMBRE_BARRIO, CLASE [4]
##   NOMBRE_BARRIO  CLASE     GRAVEDAD   conteo_mean
##   <chr>          <chr>     <chr>            <dbl>
## 1 Aguas Frias    Atropello HERIDO            3.2 
## 2 Aguas Frias    Choque    HERIDO            3.67
## 3 Aguas Frias    Choque    SOLO DAÑOS        2.5 
## 4 Aldea Pablo VI Atropello HERIDO            2.75
## 5 Aldea Pablo VI Choque    HERIDO            1.67
## 6 Aldea Pablo VI Choque    SOLO DAÑOS        2.25

Las otras variables que no se consideran importantes se remueven en la siguiente sección después de llevar los datos al formato wide.

barrios_year_full <- barrios_year_full %>%
  mutate(indicador = paste(CLASE,GRAVEDAD,sep="_"))
barrios_year_full <- barrios_year_full[,c("NOMBRE_BARRIO","indicador","conteo_mean")]
barrios_mean <- barrios_year_full %>%
  pivot_wider(values_from="conteo_mean",names_from="indicador",values_fill = 0)
head(barrios_mean)

## # A tibble: 6 x 6
## # Groups:   NOMBRE_BARRIO [6]
##   NOMBRE_BARRIO Atropello_HERIDO Choque_HERIDO `Choque_SOLO DA~ Choque_MUERTO
##   <chr>                    <dbl>         <dbl>            <dbl>         <dbl>
## 1 Aguas Frias               3.2           3.67             2.5            0  
## 2 Aldea Pablo ~             2.75          1.67             2.25           0  
## 3 Alejandría                3            15.6             57.8            1  
## 4 Alejandro Ec~            17            40               50.8            1  
## 5 Alfonso López            28.2          52.4             79.4            1.5
## 6 Altamira                  9.4          36.8             54.4            0  
## # ... with 1 more variable: Atropello_MUERTO <dbl>

Para mirar las variables que se eliminarán, se a revisará la desviación estándar de cada variable para determinar la variabilidad que aportan al conjunto de datos.

print("Desviación estándar")

## [1] "Desviación estándar"

sapply(barrios_mean[2:6],sd)

##  Atropello_HERIDO     Choque_HERIDO Choque_SOLO DAÑOS     Choque_MUERTO 
##        16.1013427        37.6918643        91.7638722         0.8234724 
##  Atropello_MUERTO 
##         0.8797056

print("Media")

## [1] "Media"

sapply(barrios_mean[2:6],mean)

##  Atropello_HERIDO     Choque_HERIDO Choque_SOLO DAÑOS     Choque_MUERTO 
##        13.1261905        30.8678030        60.6209957         0.8127165 
##  Atropello_MUERTO 
##         0.8090909

Según estos podría eliminarse toda variable que presente una desviación estándar y una media inferior a 1, pero se considera que atropello muerto y choque muerto son variables relevantes para determinar el plan de acción porque son de los accidentes con mayor frecuencia.

Ahora se agregan las variables adicionales que se incluyeron en el segundo escenario. Para esto se calcula el promedio de los accidentes por cada clase de accidente computándolos después con las tasas para cruzarlos con la información que ya se tiene de la cantidad promedio por barrio. Ya obtenida la cantidad media por todos los años para cada accidente y cada barrio solo es necesario computar el total.

barrios_total_year <- accidentes %>%
  select(NOMBRE_BARRIO,PERIODO,CLASE) %>%
  group_by(NOMBRE_BARRIO,PERIODO,CLASE) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO', 'PERIODO' (override with `.groups` argument)

head(barrios_total_year)

## # A tibble: 6 x 4
## # Groups:   NOMBRE_BARRIO, PERIODO [2]
##   NOMBRE_BARRIO PERIODO CLASE          conteo
##   <chr>           <int> <chr>           <int>
## 1 Aguas Frias      2014 Atropello           6
## 2 Aguas Frias      2014 Caida ocupante      5
## 3 Aguas Frias      2014 Choque              6
## 4 Aguas Frias      2014 Otro                4
## 5 Aguas Frias      2014 Volcamiento         1
## 6 Aguas Frias      2015 Atropello           4

## Computamos el promedio de accidentes por clase de accidente
barrios_total_full <- barrios_total_year %>%
  group_by(NOMBRE_BARRIO,CLASE) %>%
  summarize(conteo_mean = mean(conteo))

## `summarise()` regrouping output by 'NOMBRE_BARRIO' (override with `.groups` argument)

## Cruzamos con el promedio por clase y gravedad
barrios_total_year <- merge(barrios_year_full2,barrios_total_full,by = c("NOMBRE_BARRIO","CLASE"),all.x=TRUE)

## Dejamos solo los accidentes que nos interesan en su tasa, calculamos la tasa y concatenamos el nombre del indicador
barrios_total_year <- barrios_total_year %>%
  filter(CLASE %in% c("Atropello","Choque")) %>%
  mutate(perc = conteo_mean.x/conteo_mean.y,
         indicador = paste("Tasa",CLASE,GRAVEDAD,sep="_"))
barrios_total_year <- barrios_total_year[,c("NOMBRE_BARRIO","indicador","perc")]
head(barrios_total_year)

##    NOMBRE_BARRIO              indicador      perc
## 1    Aguas Frias  Tasa_Atropello_HERIDO 1.0000000
## 2    Aguas Frias     Tasa_Choque_HERIDO 0.8730159
## 3    Aguas Frias Tasa_Choque_SOLO DAÑOS 0.5952381
## 4 Aldea Pablo VI  Tasa_Atropello_HERIDO 1.0000000
## 5 Aldea Pablo VI     Tasa_Choque_HERIDO 0.5952381
## 6 Aldea Pablo VI Tasa_Choque_SOLO DAÑOS 0.8035714

## Lo llevamos a formato wide
barrios_total_indic <- barrios_total_year %>%
  pivot_wider(values_from="perc",names_from="indicador",values_fill = 0)
print("Desviación estándar")

## [1] "Desviación estándar"

sapply(barrios_total_indic[2:6],sd)

##  Tasa_Atropello_HERIDO     Tasa_Choque_HERIDO Tasa_Choque_SOLO DAÑOS 
##              0.2055471              0.1594876              0.1495639 
##     Tasa_Choque_MUERTO  Tasa_Atropello_MUERTO 
##              0.1016296              0.1255470

print("Media")

## [1] "Media"

sapply(barrios_total_indic[2:6],mean)

##  Tasa_Atropello_HERIDO     Tasa_Choque_HERIDO Tasa_Choque_SOLO DAÑOS 
##             0.93104252             0.39921682             0.63781149 
##     Tasa_Choque_MUERTO  Tasa_Atropello_MUERTO 
##             0.02696787             0.07595799

Se dejará únicamente las tasas de choque herido, tasa choque muerto y tasa atropello muerto, ya que los demás índices son el complemento de las tasas mencionadas.

barrios_total_indic <- barrios_total_indic[,c("NOMBRE_BARRIO","Tasa_Choque_HERIDO","Tasa_Choque_MUERTO","Tasa_Atropello_MUERTO")]

En general las variables se han extraído con el criterio desarrollado hasta ahora. Finalmente, se añaden al conjunto con las demás variables.

barrios_mean <- merge(barrios_mean,barrios_total_indic,by="NOMBRE_BARRIO",all.x=TRUE)
head(barrios_mean)

##          NOMBRE_BARRIO Atropello_HERIDO Choque_HERIDO Choque_SOLO DAÑOS
## 1          Aguas Frias             3.20      3.666667              2.50
## 2       Aldea Pablo VI             2.75      1.666667              2.25
## 3           Alejandría             3.00     15.600000             57.80
## 4 Alejandro Echavarría            17.00     40.000000             50.80
## 5        Alfonso López            28.20     52.400000             79.40
## 6             Altamira             9.40     36.800000             54.40
##   Choque_MUERTO Atropello_MUERTO Tasa_Choque_HERIDO Tasa_Choque_MUERTO
## 1           0.0                0          0.8730159         0.00000000
## 2           0.0                0          0.5952381         0.00000000
## 3           1.0                0          0.2119565         0.01358696
## 4           1.0                1          0.4385965         0.01096491
## 5           1.5                1          0.3957704         0.01132931
## 6           0.0                0          0.4035088         0.00000000
##   Tasa_Atropello_MUERTO
## 1            0.00000000
## 2            0.00000000
## 3            0.00000000
## 4            0.05747126
## 5            0.03448276
## 6            0.00000000

row.names(barrios_mean) <- barrios_mean$NOMBRE_BARRIO
barrios_mean <- barrios_mean[,-1]

max_list <- list()
min_list <- list()

for(i in 1:5){
  max_total <- max(barrios_mean[,i])
  min_total <- min(barrios_mean[,i])
  barrios_mean[,i] <- (barrios_mean[,i] - min_total)/(max_total - min_total)
  max_list[[i]] <- max_total
  min_list[[i]] <- min_total
}

head(barrios_mean)

##                      Atropello_HERIDO Choque_HERIDO Choque_SOLO DAÑOS
## Aguas Frias                0.01807910    0.01469017       0.004323763
## Aldea Pablo VI             0.01553672    0.00667735       0.003891387
## Alejandría                 0.01694915    0.06250000       0.099965410
## Alejandro Echavarría       0.09604520    0.16025641       0.087858872
## Alfonso López              0.15932203    0.20993590       0.137322726
## Altamira                   0.05310734    0.14743590       0.094085092
##                      Choque_MUERTO Atropello_MUERTO Tasa_Choque_HERIDO
## Aguas Frias                  0.000        0.0000000          0.8730159
## Aldea Pablo VI               0.000        0.0000000          0.5952381
## Alejandría                   0.250        0.0000000          0.2119565
## Alejandro Echavarría         0.250        0.1923077          0.4385965
## Alfonso López                0.375        0.1923077          0.3957704
## Altamira                     0.000        0.0000000          0.4035088
##                      Tasa_Choque_MUERTO Tasa_Atropello_MUERTO
## Aguas Frias                  0.00000000            0.00000000
## Aldea Pablo VI               0.00000000            0.00000000
## Alejandría                   0.01358696            0.00000000
## Alejandro Echavarría         0.01096491            0.05747126
## Alfonso López                0.01132931            0.03448276
## Altamira                     0.00000000            0.00000000

Con esta información ya puede iniciarse el proceso de agrupamiento. Este proceso lo realizará con DBSCAN ya que es el que mejor resultados ha arrojado hasta el momento. Sin embargo, se ensayará con K-medias y agrupamiento jerárquico, para determinar el mejor modelo con base al índice de Dunn.

Primero se determinan los parámetro del modelo; para ello se probará con una rejilla de valores posibles de K (para el algoritmo de vecinos más cercanos) y después con cada K se estimará el valor medio del radio a utilizar para determinar la densidad. Es decir, se probará con K = 3 hasta K = 10 y se continua anotando los valores de cada uno de los radios para después seleccionar el modelo que tenga el mayor índice de Dunn.

## Definir función para pasar la gráfica para determinar el radio con plotly
plotly_knn <- function(distancias, K){
  distancias <- distancias[order(distancias)]
  x <- seq_along(distancias)
  datos <- data.frame(x,distancias)
  fig <- plot_ly(datos, x = ~x, y = ~distancias, type = 'scatter', mode = 'lines')
  fig <- fig %>% layout(title = "Gráfica para determinar el radio a utilizar en DBSCAN",
         xaxis = list(title = "Barrios ordenados por distancia"),
         yaxis = list(title = paste("Distancia con",K,"vecinos")))
  print(paste("Distancia con",K,"vecinos"))
  return(fig)
}

## Grilla de valores
k_values <- 3:10

list_figures <- lapply(k_values, FUN = function(K){
  k_distancias <- dbscan::kNNdist(barrios_mean, k = K)
  return(plotly_knn(k_distancias,K))
})

## [1] "Distancia con 3 vecinos"
## [1] "Distancia con 4 vecinos"
## [1] "Distancia con 5 vecinos"
## [1] "Distancia con 6 vecinos"
## [1] "Distancia con 7 vecinos"
## [1] "Distancia con 8 vecinos"
## [1] "Distancia con 9 vecinos"
## [1] "Distancia con 10 vecinos"

fig <- subplot(list_figures,nrows = 4, shareX = TRUE,shareY = FALSE)

fig

De acuerdo a las gráficas se han estimado los distintos valores del radio para cada uno de los K evaluados en la grilla. Con estos datos se procede a realizara la estimación de clústers para cada uno de los escenarios y compararlos para determinar cual configuración arroja el mejor índice de Dunn.

## Valores de radios para cada uno de los puntos mínimos
eps_values <- c(0.21,0.21,0.21,0.21,0.25,0.24,0.21,0.21)
idx <- seq_along(eps_values)

## Ahora procedemos a realizara las agrupaciones con DBSCAN
list_dbscan <- lapply(idx,FUN = function(i){
  return(fpc::dbscan(barrios_mean, eps = eps_values[i], MinPts = k_values[i]))
})

dunn_full3 <- sapply(list_dbscan,FUN = function(l){
  dunn_index <- dunn(clusters = l$cluster, Data = barrios_mean)
  return(dunn_index)
})

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

data_dunn3 <- data.frame(k_values,dunn_full3)
fig <- plot_ly(data_dunn3, x = ~k_values, y = ~dunn_full3, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Indice de Dunn por cantidad de puntos")
fig

De acuerdo a esta gráfica tener hasta 9 puntos dentro no afecta significativamente el desempeño del modelo, por esto se escogerá uno de loq eue tiene la menor cantidad de puntos y lo mejoraremos probando múltiples valores de epsilon (radio).

db <- fpc::dbscan(barrios_mean, eps = 0.21, MinPts = 4)
print(table(db$cluster))

## 
##   0   1   2 
##  30 126 152

dunn(clusters = db$cluster, Data = barrios_mean)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.2504498

Después de múltiples intentos, se llega a encontrar que esta es de las mejores configuraciones que podrían obtenerse con este algoritmo,7; razón por lo cual es la elegida a usarse con los resultados de otros modelos. Así mismo, se considera necesario revisar en detalle la salida del algoritmo para determinar su funcionalidad.

db

## dbscan Pts=308 MinPts=4 eps=0.21
##         0   1   2
## border 30   2   7
## seed    0 124 145
## total  30 126 152

barrios_mean2 <- barrios_mean

## Añadimos etiqueta del grupo a cada uno de los barrios
barrios_mean2$grupo <- db$cluster

## Convertimos los datos a su escala original para mayor interpretabilidad
for(i in 1:5){
  barrios_mean2[,i] <- (barrios_mean2[,i] * (max_list[[i]] - min_list[[i]])) + min_list[[i]]
}

Aquí se encuentra algo interesante, el resultado del agrupamiento hecho con DBSCAN arroja que existen 30 puntos que se consideran como puntos con ruido, por lo que en realidad el algoritmo encontró 2 grupos densos y un grupo adicional de puntos distantes que no concuerda con la información de los demás grupos. Esto puede traer resultados adversos a la hora del agrupamiento, ya que se pueden estar uniendo en un único grupo barrios muy diferentes con casos extremos donde hay pocos accidentes y así mismo casos con demasiados accidentes.

db <- fpc::dbscan(barrios_mean, eps = 0.202, MinPts = 4)
print(table(db$cluster))

## 
##   0   1   2   3 
##  31  82 151  44

dunn(clusters = db$cluster, Data = barrios_mean)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.2028749

db

## dbscan Pts=308 MinPts=4 eps=0.202
##         0  1   2  3
## border 31  0   6  2
## seed    0 82 145 42
## total  31 82 151 44

La configuración con un radio de 0.21 arroja un mejor resultado en el índice de Dunn ya que agrupa en un solo clúster casi todos los puntos y deja en otros dos grupos puntos que se pueden considerar distantes. Al revisar los datos de los barrios arrojados por el agrupamiento de 3 clústers se encuentra que hay diferencias en los datos y que resultaría mejor dividir con un grupo adicional, tal y como lo hace la generación de 4 grupos. Así mismo, se percibe que en ambos casos existen puntos que se consideran ruido y son agrupados en el clúster 0. Es necesario revisar y asignar una etiqueta real con base en el comportamiento de estos puntos, ya que pueden ser barrios con una alta accidentalidad o una baja accidentalidad.

Vamos a revisar cada uno de los grupos y determinar que pasos siguen en el análisis.

barrios_mean2 <- barrios_mean

## Añadimos etiqueta del grupo a cada uno de los barrios
barrios_mean2$grupo <- db$cluster

## Convertimos los datos a su escala original para mayor interpretabilidad
for(i in 1:5){
  barrios_mean2[,i] <- (barrios_mean2[,i] * (max_list[[i]] - min_list[[i]])) + min_list[[i]]
}

Finalmente, para revisar estos resultados se comparan con el agrupamiento jerárquico.

## Primero se computa la matriz de dissimilaridad
d <- dist(barrios_mean, method = "euclidean")

## Usamos complete linkage como métrica entre clústers
hc3 <- hclust(d, method = "complete" )

## Dendograma
plot(hc3, cex = 0.6, hang = -1)
abline(h = 1.5, lty = 2)

Si se corta el dendograma a una altura de 1.5 podría obtenerse 3 grupos diferentes para realizar los planes de acción de acuerdo a las características de los barrios en dichas zonas.

grupos_hclust <- cutree(hc3,k=3)
print(table(grupos_hclust))

## grupos_hclust
##   1   2   3 
## 292  12   4

dunn(clusters = grupos_hclust, Data = barrios_mean)

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## [1] 0.1196852

En general tiene mejores resultados que K-Medias. Se probará con distintos grupos para determinar cual obtiene el mejor índice de Dunn.

k_test <- 3:8
k_full3 <- lapply(k_test,FUN=function(K){
  grupos_hclust <- cutree(hc3,k=K)
  return(grupos_hclust)
})

dunn_full3 <- sapply(k_full3,FUN = function(l){
  dunn_index <- dunn(clusters = l, Data = barrios_mean)
  return(dunn_index)
})

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

## Warning in if (class(distance) == "dist") distance <- as.matrix(distance): la
## condición tiene longitud > 1 y sólo el primer elemento será usado

data_dunn3 <- data.frame(k_test,dunn_full3)
fig <- plot_ly(data_dunn3, x = ~k_test, y = ~dunn_full3, type = 'scatter', mode = 'lines')
fig <- fig %>% layout(title = "Indice de Dunn por cantidad de clusters")
fig

Por los resultados encontrados en el DBSCAN se basa en este resultado como el modelo para el agrupamiento, ya que el clustering jerárquico tiene menor índice de Dunn.

barrios_mean2[barrios_mean2$grupo == 0,]

##                               Atropello_HERIDO Choque_HERIDO Choque_SOLO DAÑOS
## Andalucía                            11.200000      7.600000             17.40
## Barrio Colón                         59.600000    129.400000            436.40
## Belén                                39.600000     98.600000            289.80
## Cabecera San Antonio de Prado        46.800000     85.800000            134.00
## Campo Amor                           44.000000    208.000000            449.20
## Caribe                               31.600000    191.200000            396.60
## Castilla                             65.000000    141.800000            143.20
## Cementerio Universal                  1.250000      8.800000             21.20
## Corazón de Jesús                     40.000000    114.200000            340.80
## Cristo Rey                           29.800000    113.600000            216.00
## El Chagualo                          33.000000     79.400000            155.40
## El Nogal-Los Almendros                1.800000     16.600000             35.80
## Guayaquil                            67.400000    138.200000            492.60
## Jesús Nazareno                       33.200000     97.400000            168.80
## Juan XXIII La Quiebra                 7.800000      3.600000             10.40
## La Candelaria                       177.000000    120.000000            578.20
## La Cuchilla                           0.000000      0.000000              0.00
## La Frisola                            0.000000      0.000000              0.00
## Laureles                             16.400000     86.800000            176.40
## Manila                               10.400000     78.000000            264.40
## Ocho de Marzo                         1.600000      2.600000              3.75
## Oleoducto                             2.000000     11.200000             15.40
## Palmitas Sector Central               0.000000      1.000000              2.00
## Perpetuo Socorro                     41.200000    249.600000            554.40
## Prado                                29.400000    122.600000            157.20
## San Benito                           87.600000    127.000000            412.20
## San Diego                            15.600000     53.800000            197.00
## Santa Fé                             30.400000    169.600000            275.60
## Santa Rosa de Lima                    1.333333      1.333333              1.50
## Suburbano La Palma-El Patio           1.000000      2.333333              3.00
## Villa Nueva                          81.400000    113.800000            329.60
##                               Choque_MUERTO Atropello_MUERTO Tasa_Choque_HERIDO
## Andalucía                          3.000000         1.000000          0.2968750
## Barrio Colón                       1.000000         2.400000          0.2283798
## Belén                              1.000000         1.333333          0.2534704
## Cabecera San Antonio de Prado      3.000000         4.000000          0.3861386
## Campo Amor                         3.750000         2.500000          0.3150560
## Caribe                             2.200000         3.750000          0.3240678
## Castilla                           1.800000         2.000000          0.4944212
## Cementerio Universal               0.000000         1.000000          0.2933333
## Corazón de Jesús                   1.750000         4.000000          0.2502191
## Cristo Rey                         1.666667         2.800000          0.3436177
## El Chagualo                        1.666667         3.000000          0.3367260
## El Nogal-Los Almendros             2.000000         1.000000          0.3143939
## Guayaquil                          2.000000         5.200000          0.2185326
## Jesús Nazareno                     3.500000         2.400000          0.3620818
## Juan XXIII La Quiebra              2.000000         0.000000          0.2500000
## La Candelaria                      2.000000         5.000000          0.1717721
## La Cuchilla                        1.000000         0.000000          0.0000000
## La Frisola                         1.000000         0.000000          0.0000000
## Laureles                           2.500000         2.666667          0.3285390
## Manila                             1.000000         1.500000          0.2275379
## Ocho de Marzo                      1.000000         1.000000          0.4482759
## Oleoducto                          2.000000         1.500000          0.4028777
## Palmitas Sector Central            2.000000         1.000000          0.4444444
## Perpetuo Socorro                   2.800000         2.250000          0.3093704
## Prado                              2.500000         2.250000          0.4366097
## San Benito                         1.500000         4.800000          0.2350111
## San Diego                          4.000000         1.000000          0.2138315
## Santa Fé                           3.250000         2.000000          0.3787405
## Santa Rosa de Lima                 1.000000         0.000000          0.6060606
## Suburbano La Palma-El Patio        1.000000         1.000000          0.6666667
## Villa Nueva                        1.500000         3.000000          0.2563063
##                               Tasa_Choque_MUERTO Tasa_Atropello_MUERTO grupo
## Andalucía                            0.117187500            0.08771930     0
## Barrio Colón                         0.001764914            0.03870968     0
## Belén                                0.002570694            0.03300330     0
## Cabecera San Antonio de Prado        0.013501350            0.08000000     0
## Campo Amor                           0.005680097            0.05555556     0
## Caribe                               0.003728814            0.10838150     0
## Castilla                             0.006276151            0.03003003     0
## Cementerio Universal                 0.000000000            0.66666667     0
## Corazón de Jesús                     0.003834356            0.09090909     0
## Cristo Rey                           0.005041339            0.08588957     0
## El Chagualo                          0.007068137            0.08620690     0
## El Nogal-Los Almendros               0.037878788            0.50000000     0
## Guayaquil                            0.003162555            0.07162534     0
## Jesús Nazareno                       0.013011152            0.06741573     0
## Juan XXIII La Quiebra                0.138888889            0.00000000     0
## La Candelaria                        0.002862869            0.02747253     0
## La Cuchilla                          1.000000000            0.00000000     0
## La Frisola                           1.000000000            0.00000000     0
## Laureles                             0.009462528            0.14814815     0
## Manila                               0.002917153            0.13636364     0
## Ocho de Marzo                        0.172413793            0.55555556     0
## Oleoducto                            0.071942446            0.66666667     0
## Palmitas Sector Central              0.888888889            1.00000000     0
## Perpetuo Socorro                     0.003470501            0.05232558     0
## Prado                                0.008903134            0.07211538     0
## San Benito                           0.002775722            0.05194805     0
## San Diego                            0.015898251            0.06250000     0
## Santa Fé                             0.007257704            0.06250000     0
## Santa Rosa de Lima                   0.454545455            0.00000000     0
## Suburbano La Palma-El Patio          0.285714286            1.00000000     0
## Villa Nueva                          0.003378378            0.03554502     0

En este grupo existen barrios con alta accidentalidad, así como barrios con muy baja accidentalidad, por lo que es necesario dividirlos y asignarlos en conjuntos de datos más coherentes.

Revisaremos los demas grupos y luego dividiremos este primer grupo.

## Segundo grupo
barrios_mean2[barrios_mean2$grupo == 1,]

##                                Atropello_HERIDO Choque_HERIDO Choque_SOLO DAÑOS
## Aguas Frias                            3.200000      3.666667          2.500000
## Aldea Pablo VI                         2.750000      1.666667          2.250000
## Altamira                               9.400000     36.800000         54.400000
## Altos del Poblado                      2.000000      8.800000         19.200000
## Area De Expansion Altavista            3.666667      2.750000          2.000000
## Area De Expansion Belen Rincon         1.000000      2.000000          1.333333
## Area De Expansion El Noral             1.000000      1.333333          1.333333
## Asomadera No. 2                        2.600000     27.600000         89.000000
## Asomadera No. 3                        1.000000      2.250000          3.750000
## Astorga                                3.400000     15.400000         43.600000
## Barro Blanco                           0.000000      0.000000          1.000000
## Batallón Girardot                      2.000000      1.000000          1.000000
## Buenos Aires                          16.400000     61.200000         73.400000
## Buga Patio Bonito                      1.000000      1.600000          3.800000
## Carpinelo                              8.200000      2.750000          4.000000
## Eduardo Santos                         1.250000      1.750000          2.400000
## El Cerro                               0.000000      0.000000          1.000000
## El Corazon El Morro                    1.500000      1.500000          0.000000
## El Diamante No. 2                      2.250000      9.400000         34.200000
## El Pesebre                             5.600000     10.400000         16.200000
## El Picacho                             0.000000      0.000000          1.000000
## El Socorro                             3.400000      2.500000          2.400000
## El Triunfo                             2.400000      1.800000          3.000000
## El Vergel                              1.000000      1.500000          2.000000
## Ferrini                                5.800000     12.800000         27.600000
## Francisco Antonio Zea                 13.400000     25.000000         32.400000
## Gerona                                11.200000     21.200000         25.800000
## Hospital San Vicente de Paúl           4.000000      6.400000         17.800000
## Juan Pablo II                          2.200000      1.000000          1.600000
## La Avanzada                            2.600000      5.000000          2.600000
## La Esperanza No. 2                     7.600000      3.600000          5.800000
## La Frontera                           11.600000      9.000000         17.800000
## La Hondonada                           1.333333      6.600000         11.000000
## La Ladera                              1.600000      3.600000          6.200000
## La Loma                                1.250000      2.333333          1.750000
## La Loma Oriental                       1.000000      1.500000          2.000000
## La Mansión                             6.000000     21.200000         18.600000
## La Oculta                              1.000000      1.333333          1.666667
## La Sierra                              1.000000      1.000000          1.000000
## La Verde                               1.000000      2.333333          5.000000
## Lalinde                                2.000000      7.400000         16.600000
## Las Estancias                         14.000000      9.600000         10.800000
## Las Independencias                     6.000000      1.666667          3.400000
## Las Lomas No.1                         2.600000     23.200000         72.000000
## Las Lomas No.2                         3.000000     10.000000         33.600000
## Las Mercedes                           8.400000     21.800000         37.000000
## Los Balsos No.2                        3.200000     16.000000        108.800000
## Los Naranjos                           4.250000     19.000000         80.000000
## Llanaditas                             5.000000      2.333333          2.600000
## Metropolitano                          2.000000      2.000000          1.500000
## Mirador del Doce                       2.400000      1.400000          2.200000
## Miravalle                              3.333333      5.200000          8.200000
## Monteclaro                             2.200000      2.600000          4.600000
## Moscú No. 1                           14.200000     12.000000         23.200000
## Pajarito                               1.600000      3.600000          4.800000
## Palenque                               9.600000     22.400000         38.600000
## Pedregal Bajo                          3.000000      6.000000          4.250000
## Picachito                              4.250000      2.250000          2.000000
## Piedras Blancas Represa                0.000000      0.000000          1.000000
## Potrerito                              1.000000      0.000000          0.000000
## San Antonio                            2.000000      1.500000          1.500000
## San José de la Montaña                 0.000000      0.000000          1.000000
## San José la Cima No. 1                 3.000000      1.333333          1.250000
## San José la Cima No.2                  1.333333      0.000000          1.000000
## San Martín de Porres                  18.400000     18.000000         27.800000
## San Pablo                             23.200000     14.800000         18.400000
## Santa Elena Sector Central             0.000000      1.000000          3.000000
## Santa Teresita                         2.400000     14.800000         24.800000
## SUBURB El Plan                         8.750000      7.400000         11.750000
## Suburbano Chacaltaya                   0.000000      1.000000          1.666667
## Suburbano El Llano                     2.000000      1.000000          1.500000
## Suburbano el Tesoro                    0.000000      1.333333          3.200000
## Suburbano Mirador del Poblado          0.000000      2.400000          4.800000
## Suburbano Pedregal alto                1.000000      1.333333          1.000000
## Suburbano Santa Elena Central          0.000000      1.000000          1.000000
## Suburbano Travesias                    4.250000      3.200000          4.000000
## Trece de Noviembre                     2.250000      1.000000          3.000000
## Versalles No. 2                        3.000000      2.000000          2.200000
## Villa Flora                            4.000000      9.200000         11.200000
## Villa Liliam                           7.400000      3.200000          4.200000
## Villa Turbay                           2.666667      1.750000          1.750000
## Yolombo                                0.000000      1.000000          6.000000
##                                Choque_MUERTO Atropello_MUERTO
## Aguas Frias                                0                0
## Aldea Pablo VI                             0                0
## Altamira                                   0                0
## Altos del Poblado                          0                0
## Area De Expansion Altavista                0                0
## Area De Expansion Belen Rincon             0                0
## Area De Expansion El Noral                 0                0
## Asomadera No. 2                            0                0
## Asomadera No. 3                            0                0
## Astorga                                    0                0
## Barro Blanco                               0                0
## Batallón Girardot                          0                0
## Buenos Aires                               0                0
## Buga Patio Bonito                          0                0
## Carpinelo                                  0                0
## Eduardo Santos                             0                0
## El Cerro                                   0                0
## El Corazon El Morro                        0                0
## El Diamante No. 2                          0                0
## El Pesebre                                 0                0
## El Picacho                                 0                0
## El Socorro                                 0                0
## El Triunfo                                 0                0
## El Vergel                                  0                0
## Ferrini                                    0                0
## Francisco Antonio Zea                      0                0
## Gerona                                     0                0
## Hospital San Vicente de Paúl               0                0
## Juan Pablo II                              0                0
## La Avanzada                                0                0
## La Esperanza No. 2                         0                0
## La Frontera                                0                0
## La Hondonada                               0                0
## La Ladera                                  0                0
## La Loma                                    0                0
## La Loma Oriental                           0                0
## La Mansión                                 0                0
## La Oculta                                  0                0
## La Sierra                                  0                0
## La Verde                                   0                0
## Lalinde                                    0                0
## Las Estancias                              0                0
## Las Independencias                         0                0
## Las Lomas No.1                             0                0
## Las Lomas No.2                             0                0
## Las Mercedes                               0                0
## Los Balsos No.2                            0                0
## Los Naranjos                               0                0
## Llanaditas                                 0                0
## Metropolitano                              0                0
## Mirador del Doce                           0                0
## Miravalle                                  0                0
## Monteclaro                                 0                0
## Moscú No. 1                                0                0
## Pajarito                                   0                0
## Palenque                                   0                0
## Pedregal Bajo                              0                0
## Picachito                                  0                0
## Piedras Blancas Represa                    0                0
## Potrerito                                  0                0
## San Antonio                                0                0
## San José de la Montaña                     0                0
## San José la Cima No. 1                     0                0
## San José la Cima No.2                      0                0
## San Martín de Porres                       0                0
## San Pablo                                  0                0
## Santa Elena Sector Central                 0                0
## Santa Teresita                             0                0
## SUBURB El Plan                             0                0
## Suburbano Chacaltaya                       0                0
## Suburbano El Llano                         0                0
## Suburbano el Tesoro                        0                0
## Suburbano Mirador del Poblado              0                0
## Suburbano Pedregal alto                    0                0
## Suburbano Santa Elena Central              0                0
## Suburbano Travesias                        0                0
## Trece de Noviembre                         0                0
## Versalles No. 2                            0                0
## Villa Flora                                0                0
## Villa Liliam                               0                0
## Villa Turbay                               0                0
## Yolombo                                    0                0
##                                Tasa_Choque_HERIDO Tasa_Choque_MUERTO
## Aguas Frias                             0.8730159                  0
## Aldea Pablo VI                          0.5952381                  0
## Altamira                                0.4035088                  0
## Altos del Poblado                       0.3142857                  0
## Area De Expansion Altavista             0.8088235                  0
## Area De Expansion Belen Rincon          1.0000000                  0
## Area De Expansion El Noral              0.5000000                  0
## Asomadera No. 2                         0.2367067                  0
## Asomadera No. 3                         0.3750000                  0
## Astorga                                 0.2610169                  0
## Barro Blanco                            0.0000000                  0
## Batallón Girardot                       0.7500000                  0
## Buenos Aires                            0.4546805                  0
## Buga Patio Bonito                       0.2962963                  0
## Carpinelo                               0.4435484                  0
## Eduardo Santos                          0.4605263                  0
## El Cerro                                0.0000000                  0
## El Corazon El Morro                     1.0000000                  0
## El Diamante No. 2                       0.2155963                  0
## El Pesebre                              0.3909774                  0
## El Picacho                              0.0000000                  0
## El Socorro                              0.5681818                  0
## El Triunfo                              0.5000000                  0
## El Vergel                               0.8333333                  0
## Ferrini                                 0.3168317                  0
## Francisco Antonio Zea                   0.4355401                  0
## Gerona                                  0.4510638                  0
## Hospital San Vicente de Paúl            0.2644628                  0
## Juan Pablo II                           0.5000000                  0
## La Avanzada                             0.6578947                  0
## La Esperanza No. 2                      0.3829787                  0
## La Frontera                             0.3358209                  0
## La Hondonada                            0.3750000                  0
## La Ladera                               0.3673469                  0
## La Loma                                 0.8333333                  0
## La Loma Oriental                        0.6428571                  0
## La Mansión                              0.5326633                  0
## La Oculta                               0.5925926                  0
## La Sierra                               1.0000000                  0
## La Verde                                0.4320988                  0
## Lalinde                                 0.3083333                  0
## Las Estancias                           0.4705882                  0
## Las Independencias                      0.3787879                  0
## Las Lomas No.1                          0.2436975                  0
## Las Lomas No.2                          0.2293578                  0
## Las Mercedes                            0.3707483                  0
## Los Balsos No.2                         0.1282051                  0
## Los Naranjos                            0.1919192                  0
## Llanaditas                              0.5833333                  0
## Metropolitano                           0.8333333                  0
## Mirador del Doce                        0.3888889                  0
## Miravalle                               0.3880597                  0
## Monteclaro                              0.3611111                  0
## Moscú No. 1                             0.3409091                  0
## Pajarito                                0.4285714                  0
## Palenque                                0.3672131                  0
## Pedregal Bajo                           0.5853659                  0
## Picachito                               0.5294118                  0
## Piedras Blancas Represa                 0.0000000                  0
## Potrerito                               0.0000000                  0
## San Antonio                             0.8333333                  0
## San José de la Montaña                  0.0000000                  0
## San José la Cima No. 1                  0.7407407                  0
## San José la Cima No.2                   0.0000000                  0
## San Martín de Porres                    0.3930131                  0
## San Pablo                               0.4457831                  0
## Santa Elena Sector Central              0.3571429                  0
## Santa Teresita                          0.3737374                  0
## SUBURB El Plan                          0.4404762                  0
## Suburbano Chacaltaya                    0.5000000                  0
## Suburbano El Llano                      0.5000000                  0
## Suburbano el Tesoro                     0.3333333                  0
## Suburbano Mirador del Poblado           0.3333333                  0
## Suburbano Pedregal alto                 0.8000000                  0
## Suburbano Santa Elena Central           1.0000000                  0
## Suburbano Travesias                     0.4444444                  0
## Trece de Noviembre                      0.4444444                  0
## Versalles No. 2                         0.7692308                  0
## Villa Flora                             0.4509804                  0
## Villa Liliam                            0.4324324                  0
## Villa Turbay                            0.6250000                  0
## Yolombo                                 0.1428571                  0
##                                Tasa_Atropello_MUERTO grupo
## Aguas Frias                                        0     1
## Aldea Pablo VI                                     0     1
## Altamira                                           0     1
## Altos del Poblado                                  0     1
## Area De Expansion Altavista                        0     1
## Area De Expansion Belen Rincon                     0     1
## Area De Expansion El Noral                         0     1
## Asomadera No. 2                                    0     1
## Asomadera No. 3                                    0     1
## Astorga                                            0     1
## Barro Blanco                                       0     1
## Batallón Girardot                                  0     1
## Buenos Aires                                       0     1
## Buga Patio Bonito                                  0     1
## Carpinelo                                          0     1
## Eduardo Santos                                     0     1
## El Cerro                                           0     1
## El Corazon El Morro                                0     1
## El Diamante No. 2                                  0     1
## El Pesebre                                         0     1
## El Picacho                                         0     1
## El Socorro                                         0     1
## El Triunfo                                         0     1
## El Vergel                                          0     1
## Ferrini                                            0     1
## Francisco Antonio Zea                              0     1
## Gerona                                             0     1
## Hospital San Vicente de Paúl                       0     1
## Juan Pablo II                                      0     1
## La Avanzada                                        0     1
## La Esperanza No. 2                                 0     1
## La Frontera                                        0     1
## La Hondonada                                       0     1
## La Ladera                                          0     1
## La Loma                                            0     1
## La Loma Oriental                                   0     1
## La Mansión                                         0     1
## La Oculta                                          0     1
## La Sierra                                          0     1
## La Verde                                           0     1
## Lalinde                                            0     1
## Las Estancias                                      0     1
## Las Independencias                                 0     1
## Las Lomas No.1                                     0     1
## Las Lomas No.2                                     0     1
## Las Mercedes                                       0     1
## Los Balsos No.2                                    0     1
## Los Naranjos                                       0     1
## Llanaditas                                         0     1
## Metropolitano                                      0     1
## Mirador del Doce                                   0     1
## Miravalle                                          0     1
## Monteclaro                                         0     1
## Moscú No. 1                                        0     1
## Pajarito                                           0     1
## Palenque                                           0     1
## Pedregal Bajo                                      0     1
## Picachito                                          0     1
## Piedras Blancas Represa                            0     1
## Potrerito                                          0     1
## San Antonio                                        0     1
## San José de la Montaña                             0     1
## San José la Cima No. 1                             0     1
## San José la Cima No.2                              0     1
## San Martín de Porres                               0     1
## San Pablo                                          0     1
## Santa Elena Sector Central                         0     1
## Santa Teresita                                     0     1
## SUBURB El Plan                                     0     1
## Suburbano Chacaltaya                               0     1
## Suburbano El Llano                                 0     1
## Suburbano el Tesoro                                0     1
## Suburbano Mirador del Poblado                      0     1
## Suburbano Pedregal alto                            0     1
## Suburbano Santa Elena Central                      0     1
## Suburbano Travesias                                0     1
## Trece de Noviembre                                 0     1
## Versalles No. 2                                    0     1
## Villa Flora                                        0     1
## Villa Liliam                                       0     1
## Villa Turbay                                       0     1
## Yolombo                                            0     1

## Tercer grupo
barrios_mean2[barrios_mean2$grupo == 2,]

##                                        Atropello_HERIDO Choque_HERIDO
## Alejandría                                     3.000000     15.600000
## Alejandro Echavarría                          17.000000     40.000000
## Alfonso López                                 28.200000     52.400000
## Altavista                                     12.000000     10.800000
## Altavista Sector Central                       4.600000      4.200000
## Antonio Nariño                                 8.800000     10.200000
## Aranjuez                                      10.200000     16.600000
## Area de Expansion Altos de Calasanz            1.750000      2.200000
## Área de Expansión Pajarito                    17.600000     35.600000
## Área de Expansión San Antonio de Prado         2.750000      5.000000
## Asomadera No. 1                                5.400000     18.400000
## B. Cerro  El Volador                           2.250000      6.400000
## Barrio Caicedo                                19.800000     29.800000
## Barrio Colombia                               13.600000     52.600000
## Barrio de Jesús                                8.200000     10.000000
## Belalcázar                                     6.200000     35.000000
## Belencito                                      4.400000     12.800000
## Berlin                                        32.600000     33.000000
## Betania                                        4.400000      3.800000
## Bolivariana                                    8.200000     52.600000
## Bomboná No. 1                                 16.200000     61.200000
## Bosques de San Pablo                           8.400000     23.000000
## Boston                                        42.800000    132.200000
## Brasilia                                      15.400000     32.000000
## Cabecera Urbana San Cristobal                 20.000000     21.800000
## Calasanz                                      10.800000     42.400000
## Calle Nueva                                   24.200000     50.800000
## Campo Alegre                                  11.400000     35.400000
## Campo Valdés No. 1                            38.000000     81.000000
## Campo Valdés No. 2                            41.800000     56.800000
## Carlos E. Restrepo                            26.200000    128.200000
## Castropol                                     10.400000     53.800000
## Cataluña                                       8.400000     12.400000
## Centro Administrativo                          5.200000     18.200000
## Cerro Nutibara                                 6.600000     39.600000
## Cuarta Brigada                                20.800000     65.600000
## Cucaracho                                     14.200000     52.000000
## Diego Echavarría                               1.000000      7.600000
## Doce de Octubre No.2                          23.000000     30.200000
## El Corazón                                     4.000000      5.600000
## El Danubio                                     6.000000     27.000000
## El Diamante                                   37.600000     68.200000
## El Pinal                                      23.200000     16.000000
## El Poblado                                    10.800000     35.400000
## El Progreso No.2                               4.600000      4.400000
## El Rodeo                                       3.800000      7.600000
## El Salado                                      6.800000      5.800000
## El Salvador                                   13.800000     22.200000
## El Tesoro                                      2.000000     20.000000
## El Velódromo                                   7.000000     45.600000
## Enciso                                        18.400000     42.400000
## Estación Villa                                35.800000     35.600000
## Facultad de Minas U. Nacional                  8.000000     42.000000
## Fátima                                         8.000000     33.400000
## Florida Nueva                                 19.600000     39.000000
## Girardot                                      17.200000     49.000000
## Granada                                        4.400000     18.400000
## Granizal                                      16.600000      6.000000
## Guayabal                                      17.800000     72.600000
## Héctor Abad Gómez                              7.800000     52.200000
## Kennedy                                       38.000000     31.000000
## La Aguacatala                                  9.000000     82.200000
## La Castellana                                  8.000000     42.400000
## La Colina                                     11.000000     21.800000
## La Cruz                                        6.800000      3.400000
## La Esperanza                                  30.000000     29.000000
## La Floresta                                   13.800000     38.400000
## La Francia                                    12.800000      9.400000
## La Gloria                                     11.600000     53.600000
## La Isla                                       16.000000      7.400000
## La Libertad                                    8.400000      7.200000
## La Milagrosa                                  10.600000     31.200000
## La mota                                        7.200000     26.000000
## La Piñuela                                    10.400000     18.000000
## La Pradera                                    11.000000     14.600000
## La Rosa                                       10.400000     13.400000
## La Salle                                      26.800000     20.600000
## Las Acacias                                   16.200000     70.400000
## Las Brisas                                     8.400000     32.400000
## Las Esmeraldas                                12.400000     15.800000
## Las Granjas                                   52.000000     47.200000
## Las Palmas                                    10.000000     29.000000
## Las Violetas                                  14.200000     13.000000
## Lorena                                        15.400000     51.200000
## Loreto                                        21.000000     22.600000
## Los Alcázares                                  7.400000     24.400000
## Los Alpes                                      9.600000     24.600000
## Los Balsos No.1                                1.666667     11.600000
## Los Cerros El Vergel                          10.000000     18.800000
## Los Colores                                   35.400000    108.200000
## Los Conquistadores                            26.400000    149.600000
## Los Mangos                                    20.600000     21.400000
## Los Pinos                                     15.400000     41.000000
## Manrique Central No. 1                        18.400000     65.800000
## Manrique Central No. 2                        18.600000     39.600000
## Manrique Oriental                             28.800000     53.600000
## Media Luna                                     1.666667      4.000000
## Miraflores                                     8.600000     33.200000
## Miranda                                       27.400000     53.800000
## Moravia                                       39.000000     35.800000
## Naranjal                                      28.400000    104.200000
## Nueva Villa de Aburrá                          4.750000      9.400000
## Nuevos Conquistadores                          6.000000      2.250000
## Olaya Herrera                                  8.800000      6.600000
## Pablo VI                                       5.000000      3.666667
## Palermo                                       11.600000     19.200000
## Parque Juan Pablo II                           7.800000     41.200000
## Parque Norte                                  26.200000     42.600000
## Patio Bonito                                   7.400000     49.800000
## Pedregal                                      30.600000     43.600000
## Playón de Los Comuneros                       11.200000     12.800000
## Plaza de Ferias                                5.600000     27.800000
## Robledo                                       16.800000     44.800000
## Rosales                                       17.200000    128.800000
## San Bernardo                                  23.000000     61.400000
## San Germán                                     9.600000     32.000000
## San Isidro                                    24.000000     46.600000
## San Javier No.1                               23.200000     41.600000
## San Joaquín                                   13.600000     53.200000
## San Lucas                                      1.800000      3.200000
## San Miguel                                    13.000000     60.400000
## San Pedro                                     16.400000     43.400000
## Santa Cruz                                    17.400000     19.600000
## Santa Inés                                    27.400000     28.600000
## Santa Lucía                                   11.000000     12.400000
## Santa María de los Ángeles                     4.000000     34.200000
## Santa Mónica                                   3.800000     24.200000
## Santander                                     23.000000     17.600000
## Santo Domingo Savio No. 1                     39.600000     10.600000
## Sevilla                                       25.000000     60.000000
## Simón Bolívar                                  6.500000     33.600000
## Suburbano Altavista                            2.800000      4.800000
## Sucre                                         15.400000     48.000000
## Suramericana                                  14.200000     68.600000
## Tejelo                                        21.000000     32.000000
## Tenche                                         7.600000     57.000000
## Terminal de Transporte                        29.600000    108.400000
## Toscana                                        9.200000     43.800000
## Tricentenario                                 10.400000     56.200000
## Trinidad                                      29.600000     70.200000
## U.D. Atanasio Girardot                         7.800000     18.200000
## U.P.B.                                         3.400000     10.200000
## Universidad de Antioquia                       9.800000     48.200000
## Universidad Nacional                          21.400000    130.800000
## Veinte de Julio                               13.200000     17.200000
## Versalles No. 1                               25.000000     13.600000
## Villa Carlota                                 14.600000    107.600000
## Villa del Socorro                             19.600000     16.200000
## Villa Guadalupe                               20.400000     13.600000
## Villa Niza                                     4.400000      4.000000
## Villatina                                     20.000000     14.200000
##                                        Choque_SOLO DAÑOS Choque_MUERTO
## Alejandría                                          57.8      1.000000
## Alejandro Echavarría                                50.8      1.000000
## Alfonso López                                       79.4      1.500000
## Altavista                                           22.0      1.000000
## Altavista Sector Central                             6.0      1.000000
## Antonio Nariño                                       9.8      1.000000
## Aranjuez                                            19.2      1.000000
## Area de Expansion Altos de Calasanz                  5.2      1.000000
## Área de Expansión Pajarito                          36.6      1.666667
## Área de Expansión San Antonio de Prado               3.8      1.000000
## Asomadera No. 1                                     53.2      1.000000
## B. Cerro  El Volador                                 8.2      1.000000
## Barrio Caicedo                                      54.2      1.000000
## Barrio Colombia                                    132.6      1.000000
## Barrio de Jesús                                     17.2      1.000000
## Belalcázar                                          51.2      1.000000
## Belencito                                            9.8      1.000000
## Berlin                                              53.2      2.000000
## Betania                                              7.8      1.000000
## Bolivariana                                         91.8      1.000000
## Bomboná No. 1                                      132.6      1.000000
## Bosques de San Pablo                                62.8      1.000000
## Boston                                             223.2      1.000000
## Brasilia                                            26.4      1.500000
## Cabecera Urbana San Cristobal                       31.0      1.000000
## Calasanz                                            95.2      1.000000
## Calle Nueva                                        170.8      1.000000
## Campo Alegre                                        36.4      1.500000
## Campo Valdés No. 1                                  61.4      1.666667
## Campo Valdés No. 2                                  32.8      1.666667
## Carlos E. Restrepo                                 317.2      2.000000
## Castropol                                          132.2      2.000000
## Cataluña                                            28.0      1.000000
## Centro Administrativo                               45.6      1.000000
## Cerro Nutibara                                      69.8      1.333333
## Cuarta Brigada                                     123.2      1.000000
## Cucaracho                                           53.2      1.500000
## Diego Echavarría                                    16.8      1.000000
## Doce de Octubre No.2                                28.0      1.000000
## El Corazón                                           4.6      1.000000
## El Danubio                                          29.4      1.000000
## El Diamante                                         78.4      1.000000
## El Pinal                                            42.8      1.000000
## El Poblado                                         172.0      1.000000
## El Progreso No.2                                     7.6      1.000000
## El Rodeo                                            12.8      1.000000
## El Salado                                           10.4      1.000000
## El Salvador                                         38.6      1.000000
## El Tesoro                                           60.0      1.000000
## El Velódromo                                        66.6      1.000000
## Enciso                                              36.4      2.000000
## Estación Villa                                      97.6      1.333333
## Facultad de Minas U. Nacional                       92.8      1.000000
## Fátima                                              54.4      1.500000
## Florida Nueva                                       84.6      2.500000
## Girardot                                            60.2      2.000000
## Granada                                             32.8      1.000000
## Granizal                                            22.6      1.333333
## Guayabal                                           174.4      1.000000
## Héctor Abad Gómez                                   73.6      1.500000
## Kennedy                                             48.0      1.000000
## La Aguacatala                                      231.6      2.000000
## La Castellana                                       78.6      1.000000
## La Colina                                           53.0      1.000000
## La Cruz                                              4.8      1.000000
## La Esperanza                                        22.4      1.000000
## La Floresta                                         69.6      1.000000
## La Francia                                          18.2      1.000000
## La Gloria                                           94.8      1.000000
## La Isla                                             14.2      1.000000
## La Libertad                                         17.0      1.000000
## La Milagrosa                                        39.2      1.500000
## La mota                                             50.2      1.000000
## La Piñuela                                          18.0      1.000000
## La Pradera                                          19.6      1.000000
## La Rosa                                             11.8      1.000000
## La Salle                                            21.0      1.000000
## Las Acacias                                        174.8      1.500000
## Las Brisas                                          54.2      1.000000
## Las Esmeraldas                                      27.4      1.500000
## Las Granjas                                         56.2      2.750000
## Las Palmas                                          60.4      1.666667
## Las Violetas                                        26.4      1.000000
## Lorena                                              95.2      1.000000
## Loreto                                              39.8      1.000000
## Los Alcázares                                       33.4      1.000000
## Los Alpes                                           36.4      1.000000
## Los Balsos No.1                                     42.0      1.000000
## Los Cerros El Vergel                                20.2      2.000000
## Los Colores                                        171.2      1.000000
## Los Conquistadores                                 361.0      2.250000
## Los Mangos                                          28.8      1.000000
## Los Pinos                                           93.0      1.000000
## Manrique Central No. 1                              64.6      2.000000
## Manrique Central No. 2                              34.8      2.000000
## Manrique Oriental                                   50.0      1.000000
## Media Luna                                           4.0      1.500000
## Miraflores                                          36.0      1.000000
## Miranda                                             81.4      2.000000
## Moravia                                             62.4      1.500000
## Naranjal                                           305.2      1.800000
## Nueva Villa de Aburrá                               18.8      1.000000
## Nuevos Conquistadores                                5.2      1.000000
## Olaya Herrera                                        8.8      1.000000
## Pablo VI                                             5.4      1.000000
## Palermo                                             29.2      1.000000
## Parque Juan Pablo II                                56.6      1.500000
## Parque Norte                                        71.6      1.000000
## Patio Bonito                                       143.2      1.000000
## Pedregal                                            35.0      1.000000
## Playón de Los Comuneros                             16.0      1.000000
## Plaza de Ferias                                     35.4      1.000000
## Robledo                                             62.4      1.000000
## Rosales                                            176.0      1.250000
## San Bernardo                                        86.8      3.000000
## San Germán                                          58.0      1.000000
## San Isidro                                          46.4      1.333333
## San Javier No.1                                     47.2      1.000000
## San Joaquín                                        100.2      1.333333
## San Lucas                                           29.0      1.000000
## San Miguel                                          48.0      1.500000
## San Pedro                                           86.0      1.000000
## Santa Cruz                                          18.6      1.000000
## Santa Inés                                          33.0      1.500000
## Santa Lucía                                         19.0      1.000000
## Santa María de los Ángeles                          99.4      2.000000
## Santa Mónica                                        24.2      1.000000
## Santander                                           15.6      1.000000
## Santo Domingo Savio No. 1                           25.6      1.000000
## Sevilla                                            119.4      1.250000
## Simón Bolívar                                       39.4      1.000000
## Suburbano Altavista                                  3.6      1.000000
## Sucre                                               44.4      1.000000
## Suramericana                                       178.0      1.500000
## Tejelo                                              34.6      3.000000
## Tenche                                              89.2      2.000000
## Terminal de Transporte                             275.6      1.800000
## Toscana                                             58.8      2.333333
## Tricentenario                                       84.2      1.500000
## Trinidad                                           113.6      1.000000
## U.D. Atanasio Girardot                              35.0      1.000000
## U.P.B.                                              47.6      1.000000
## Universidad de Antioquia                           103.8      1.666667
## Universidad Nacional                               215.0      1.500000
## Veinte de Julio                                     13.8      1.500000
## Versalles No. 1                                     30.6      1.000000
## Villa Carlota                                      248.4      2.000000
## Villa del Socorro                                   33.0      1.000000
## Villa Guadalupe                                     19.8      1.000000
## Villa Niza                                           6.2      1.000000
## Villatina                                           27.2      1.000000
##                                        Atropello_MUERTO Tasa_Choque_HERIDO
## Alejandría                                     0.000000         0.21195652
## Alejandro Echavarría                           1.000000         0.43859649
## Alfonso López                                  1.000000         0.39577039
## Altavista                                      1.000000         0.32530120
## Altavista Sector Central                       0.000000         0.38888889
## Antonio Nariño                                 0.000000         0.50495050
## Aranjuez                                       0.000000         0.46111111
## Area de Expansion Altos de Calasanz            0.000000         0.28947368
## Área de Expansión Pajarito                     1.000000         0.48633880
## Área de Expansión San Antonio de Prado         0.000000         0.54347826
## Asomadera No. 1                                1.000000         0.25626741
## B. Cerro  El Volador                           0.000000         0.43243243
## Barrio Caicedo                                 1.000000         0.35224586
## Barrio Colombia                                1.000000         0.28371090
## Barrio de Jesús                                1.000000         0.35971223
## Belalcázar                                     1.000000         0.40415704
## Belencito                                      1.000000         0.56140351
## Berlin                                         1.000000         0.38106236
## Betania                                        1.000000         0.32203390
## Bolivariana                                    1.000000         0.36376210
## Bomboná No. 1                                  1.000000         0.31481481
## Bosques de San Pablo                           0.000000         0.26744186
## Boston                                         2.000000         0.37155705
## Brasilia                                       1.000000         0.54237288
## Cabecera Urbana San Cristobal                  1.333333         0.40977444
## Calasanz                                       1.500000         0.30769231
## Calle Nueva                                    1.000000         0.22862286
## Campo Alegre                                   0.000000         0.48895028
## Campo Valdés No. 1                             1.500000         0.56485356
## Campo Valdés No. 2                             1.000000         0.62693157
## Carlos E. Restrepo                             2.000000         0.28757290
## Castropol                                      1.500000         0.28862661
## Cataluña                                       0.000000         0.30541872
## Centro Administrativo                          1.000000         0.28437500
## Cerro Nutibara                                 1.000000         0.35934664
## Cuarta Brigada                                 1.333333         0.34708995
## Cucaracho                                      0.000000         0.49149338
## Diego Echavarría                               0.000000         0.30894309
## Doce de Octubre No.2                           1.000000         0.51535836
## El Corazón                                     1.000000         0.53846154
## El Danubio                                     1.000000         0.47535211
## El Diamante                                    1.000000         0.46457766
## El Pinal                                       1.000000         0.27027027
## El Poblado                                     1.000000         0.17052023
## El Progreso No.2                               1.000000         0.36065574
## El Rodeo                                       0.000000         0.36893204
## El Salado                                      0.000000         0.35365854
## El Salvador                                    1.000000         0.36393443
## El Tesoro                                      0.000000         0.24937656
## El Velódromo                                   1.000000         0.40569395
## Enciso                                         2.000000         0.53000000
## Estación Villa                                 2.666667         0.26567164
## Facultad de Minas U. Nacional                  1.000000         0.31065089
## Fátima                                         1.000000         0.37782805
## Florida Nueva                                  1.000000         0.31300161
## Girardot                                       1.500000         0.44708029
## Granada                                        0.000000         0.35797665
## Granizal                                       1.500000         0.20408163
## Guayabal                                       2.000000         0.29368932
## Héctor Abad Gómez                              1.666667         0.41102362
## Kennedy                                        0.000000         0.39141414
## La Aguacatala                                  1.000000         0.26062143
## La Castellana                                  1.000000         0.34983498
## La Colina                                      1.500000         0.29066667
## La Cruz                                        0.000000         0.40476190
## La Esperanza                                   1.500000         0.55984556
## La Floresta                                    1.000000         0.35489834
## La Francia                                     0.000000         0.33812950
## La Gloria                                      0.000000         0.36069987
## La Isla                                        1.000000         0.33944954
## La Libertad                                    0.000000         0.29508197
## La Milagrosa                                   1.000000         0.43943662
## La mota                                        1.000000         0.33942559
## La Piñuela                                     1.000000         0.49450549
## La Pradera                                     0.000000         0.42441860
## La Rosa                                        1.000000         0.52755906
## La Salle                                       1.000000         0.49282297
## Las Acacias                                    1.500000         0.28641172
## Las Brisas                                     1.000000         0.37327189
## Las Esmeraldas                                 1.000000         0.36073059
## Las Granjas                                    1.000000         0.44696970
## Las Palmas                                     0.000000         0.32079646
## Las Violetas                                   1.000000         0.32663317
## Lorena                                         1.666667         0.34877384
## Loreto                                         1.500000         0.36102236
## Los Alcázares                                  1.000000         0.41780822
## Los Alpes                                      1.000000         0.40196078
## Los Balsos No.1                                0.000000         0.21402214
## Los Cerros El Vergel                           1.000000         0.47715736
## Los Colores                                    1.600000         0.38642857
## Los Conquistadores                             1.500000         0.29195941
## Los Mangos                                     1.000000         0.42292490
## Los Pinos                                      1.000000         0.30460624
## Manrique Central No. 1                         1.333333         0.50152439
## Manrique Central No. 2                         1.000000         0.52941176
## Manrique Oriental                              1.500000         0.51439539
## Media Luna                                     0.000000         0.51612903
## Miraflores                                     0.000000         0.47701149
## Miranda                                        1.000000         0.39675516
## Moravia                                        1.750000         0.36016097
## Naranjal                                       1.333333         0.25340467
## Nueva Villa de Aburrá                          0.000000         0.33098592
## Nuevos Conquistadores                          0.000000         0.31250000
## Olaya Herrera                                  0.000000         0.42307692
## Pablo VI                                       1.000000         0.47008547
## Palermo                                        0.000000         0.39344262
## Parque Juan Pablo II                           1.000000         0.41616162
## Parque Norte                                   3.000000         0.37237762
## Patio Bonito                                   0.000000         0.25723140
## Pedregal                                       2.000000         0.55189873
## Playón de Los Comuneros                        0.000000         0.43835616
## Plaza de Ferias                                1.000000         0.43710692
## Robledo                                        1.000000         0.41558442
## Rosales                                        2.000000         0.42119032
## San Bernardo                                   1.000000         0.41097724
## San Germán                                     1.000000         0.35398230
## San Isidro                                     1.000000         0.49680171
## San Javier No.1                                1.000000         0.46741573
## San Joaquín                                    1.250000         0.34500649
## San Lucas                                      0.000000         0.09876543
## San Miguel                                     1.000000         0.55412844
## San Pedro                                      2.500000         0.33436055
## Santa Cruz                                     1.000000         0.51041667
## Santa Inés                                     1.000000         0.45980707
## Santa Lucía                                    0.000000         0.39240506
## Santa María de los Ángeles                     1.000000         0.25370920
## Santa Mónica                                   1.000000         0.49794239
## Santander                                      1.250000         0.52694611
## Santo Domingo Savio No. 1                      1.333333         0.29120879
## Sevilla                                        1.500000         0.33259424
## Simón Bolívar                                  1.000000         0.45901639
## Suburbano Altavista                            1.000000         0.55813953
## Sucre                                          0.000000         0.51612903
## Suramericana                                   1.000000         0.27683616
## Tejelo                                         1.000000         0.47619048
## Tenche                                         1.000000         0.38775510
## Terminal de Transporte                         1.400000         0.28097460
## Toscana                                        1.500000         0.42115385
## Tricentenario                                  0.000000         0.39858156
## Trinidad                                       1.500000         0.38069414
## U.D. Atanasio Girardot                         0.000000         0.33955224
## U.P.B.                                         0.000000         0.17586207
## Universidad de Antioquia                       1.000000         0.31503268
## Universidad Nacional                           1.500000         0.37694524
## Veinte de Julio                                2.000000         0.54430380
## Versalles No. 1                                1.000000         0.30493274
## Villa Carlota                                  1.000000         0.30089485
## Villa del Socorro                              2.000000         0.32793522
## Villa Guadalupe                                1.000000         0.40476190
## Villa Niza                                     1.000000         0.41666667
## Villatina                                      0.000000         0.33971292
##                                        Tasa_Choque_MUERTO Tasa_Atropello_MUERTO
## Alejandría                                    0.013586957            0.00000000
## Alejandro Echavarría                          0.010964912            0.05747126
## Alfonso López                                 0.011329305            0.03448276
## Altavista                                     0.030120482            0.08196721
## Altavista Sector Central                      0.092592593            0.00000000
## Antonio Nariño                                0.049504950            0.00000000
## Aranjuez                                      0.027777778            0.00000000
## Area de Expansion Altos de Calasanz           0.131578947            0.00000000
## Área de Expansión Pajarito                    0.022768670            0.05434783
## Área de Expansión San Antonio de Prado        0.108695652            0.00000000
## Asomadera No. 1                               0.013927577            0.17857143
## B. Cerro  El Volador                          0.067567568            0.00000000
## Barrio Caicedo                                0.011820331            0.04950495
## Barrio Colombia                               0.005393743            0.07246377
## Barrio de Jesús                               0.035971223            0.11904762
## Belalcázar                                    0.011547344            0.15625000
## Belencito                                     0.043859649            0.21739130
## Berlin                                        0.023094688            0.03030303
## Betania                                       0.084745763            0.21739130
## Bolivariana                                   0.006915629            0.11627907
## Bomboná No. 1                                 0.005144033            0.05882353
## Bosques de San Pablo                          0.011627907            0.00000000
## Boston                                        0.002810568            0.04464286
## Brasilia                                      0.025423729            0.06410256
## Cabecera Urbana San Cristobal                 0.018796992            0.06410256
## Calasanz                                      0.007256894            0.13157895
## Calle Nueva                                   0.004500450            0.04065041
## Campo Alegre                                  0.020718232            0.00000000
## Campo Valdés No. 1                            0.011622501            0.03886010
## Campo Valdés No. 2                            0.018395879            0.02358491
## Carlos E. Restrepo                            0.004486317            0.07407407
## Castropol                                     0.010729614            0.13636364
## Cataluña                                      0.024630542            0.00000000
## Centro Administrativo                         0.015625000            0.18518519
## Cerro Nutibara                                0.012099214            0.14705882
## Cuarta Brigada                                0.005291005            0.06172840
## Cucaracho                                     0.014177694            0.00000000
## Diego Echavarría                              0.040650407            0.00000000
## Doce de Octubre No.2                          0.017064846            0.04201681
## El Corazón                                    0.096153846            0.23809524
## El Danubio                                    0.017605634            0.16129032
## El Diamante                                   0.006811989            0.02645503
## El Pinal                                      0.016891892            0.04273504
## El Poblado                                    0.004816956            0.08928571
## El Progreso No.2                              0.081967213            0.20833333
## El Rodeo                                      0.048543689            0.00000000
## El Salado                                     0.060975610            0.00000000
## El Salvador                                   0.016393443            0.07042254
## El Tesoro                                     0.012468828            0.00000000
## El Velódromo                                  0.008896797            0.13513514
## Enciso                                        0.025000000            0.10416667
## Estación Villa                                0.009950249            0.07130125
## Facultad de Minas U. Nacional                 0.007396450            0.12195122
## Fátima                                        0.016968326            0.12195122
## Florida Nueva                                 0.020064205            0.05000000
## Girardot                                      0.018248175            0.08152174
## Granada                                       0.019455253            0.00000000
## Granizal                                      0.045351474            0.08720930
## Guayabal                                      0.004045307            0.10526316
## Héctor Abad Gómez                             0.011811024            0.18939394
## Kennedy                                       0.012626263            0.00000000
## La Aguacatala                                 0.006341154            0.10638298
## La Castellana                                 0.008250825            0.12195122
## La Colina                                     0.013333333            0.12931034
## La Cruz                                       0.119047619            0.00000000
## La Esperanza                                  0.019305019            0.04901961
## La Floresta                                   0.009242144            0.06944444
## La Francia                                    0.035971223            0.00000000
## La Gloria                                     0.006729475            0.00000000
## La Isla                                       0.045871560            0.06172840
## La Libertad                                   0.040983607            0.00000000
## La Milagrosa                                  0.021126761            0.08928571
## La mota                                       0.013054830            0.13513514
## La Piñuela                                    0.027472527            0.09259259
## La Pradera                                    0.029069767            0.00000000
## La Rosa                                       0.039370079            0.09433962
## La Salle                                      0.023923445            0.03649635
## Las Acacias                                   0.006102522            0.08928571
## Las Brisas                                    0.011520737            0.10869565
## Las Esmeraldas                                0.034246575            0.07692308
## Las Granjas                                   0.026041667            0.01908397
## Las Palmas                                    0.018436578            0.00000000
## Las Violetas                                  0.025125628            0.06944444
## Lorena                                        0.006811989            0.10162602
## Loreto                                        0.015974441            0.06944444
## Los Alcázares                                 0.017123288            0.12820513
## Los Alpes                                     0.016339869            0.10204082
## Los Balsos No.1                               0.018450185            0.00000000
## Los Cerros El Vergel                          0.050761421            0.09803922
## Los Colores                                   0.003571429            0.04324324
## Los Conquistadores                            0.004391101            0.05434783
## Los Mangos                                    0.019762846            0.04807692
## Los Pinos                                     0.007429421            0.06329114
## Manrique Central No. 1                        0.015243902            0.06944444
## Manrique Central No. 2                        0.026737968            0.05319149
## Manrique Oriental                             0.009596929            0.05102041
## Media Luna                                    0.193548387            0.00000000
## Miraflores                                    0.014367816            0.00000000
## Miranda                                       0.014749263            0.03623188
## Moravia                                       0.015090543            0.04331683
## Naranjal                                      0.004377432            0.04566210
## Nueva Villa de Aburrá                         0.035211268            0.00000000
## Nuevos Conquistadores                         0.138888889            0.00000000
## Olaya Herrera                                 0.064102564            0.00000000
## Pablo VI                                      0.128205128            0.19230769
## Palermo                                       0.020491803            0.00000000
## Parque Juan Pablo II                          0.015151515            0.11904762
## Parque Norte                                  0.008741259            0.10948905
## Patio Bonito                                  0.005165289            0.00000000
## Pedregal                                      0.012658228            0.06369427
## Playón de Los Comuneros                       0.034246575            0.00000000
## Plaza de Ferias                               0.015723270            0.17241379
## Robledo                                       0.009276438            0.05882353
## Rosales                                       0.004087639            0.11363636
## San Bernardo                                  0.020080321            0.04201681
## San Germán                                    0.011061947            0.09803922
## San Isidro                                    0.014214641            0.04132231
## San Javier No.1                               0.011235955            0.04237288
## San Joaquín                                   0.008646779            0.08561644
## San Lucas                                     0.030864198            0.00000000
## San Miguel                                    0.013761468            0.07462687
## San Pedro                                     0.007704160            0.14367816
## Santa Cruz                                    0.026041667            0.05555556
## Santa Inés                                    0.024115756            0.03571429
## Santa Lucía                                   0.031645570            0.00000000
## Santa María de los Ángeles                    0.014836795            0.23809524
## Santa Mónica                                  0.020576132            0.25000000
## Santander                                     0.029940120            0.05208333
## Santo Domingo Savio No. 1                     0.027472527            0.03300330
## Sevilla                                       0.006929047            0.05859375
## Simón Bolívar                                 0.013661202            0.14814815
## Suburbano Altavista                           0.116279070            0.33333333
## Sucre                                         0.010752688            0.00000000
## Suramericana                                  0.006053269            0.06849315
## Tejelo                                        0.044642857            0.04672897
## Tenche                                        0.013605442            0.12820513
## Terminal de Transporte                        0.004665630            0.04516129
## Toscana                                       0.022435897            0.15306122
## Tricentenario                                 0.010638298            0.00000000
## Trinidad                                      0.005422993            0.04966887
## U.D. Atanasio Girardot                        0.018656716            0.00000000
## U.P.B.                                        0.017241379            0.00000000
## Universidad de Antioquia                      0.010893246            0.09803922
## Universidad Nacional                          0.004322767            0.06637168
## Veinte de Julio                               0.047468354            0.14285714
## Versalles No. 1                               0.022421525            0.03968254
## Villa Carlota                                 0.005592841            0.06756757
## Villa del Socorro                             0.020242915            0.10000000
## Villa Guadalupe                               0.029761905            0.04807692
## Villa Niza                                    0.104166667            0.21739130
## Villatina                                     0.023923445            0.00000000
##                                        grupo
## Alejandría                                 2
## Alejandro Echavarría                       2
## Alfonso López                              2
## Altavista                                  2
## Altavista Sector Central                   2
## Antonio Nariño                             2
## Aranjuez                                   2
## Area de Expansion Altos de Calasanz        2
## Área de Expansión Pajarito                 2
## Área de Expansión San Antonio de Prado     2
## Asomadera No. 1                            2
## B. Cerro  El Volador                       2
## Barrio Caicedo                             2
## Barrio Colombia                            2
## Barrio de Jesús                            2
## Belalcázar                                 2
## Belencito                                  2
## Berlin                                     2
## Betania                                    2
## Bolivariana                                2
## Bomboná No. 1                              2
## Bosques de San Pablo                       2
## Boston                                     2
## Brasilia                                   2
## Cabecera Urbana San Cristobal              2
## Calasanz                                   2
## Calle Nueva                                2
## Campo Alegre                               2
## Campo Valdés No. 1                         2
## Campo Valdés No. 2                         2
## Carlos E. Restrepo                         2
## Castropol                                  2
## Cataluña                                   2
## Centro Administrativo                      2
## Cerro Nutibara                             2
## Cuarta Brigada                             2
## Cucaracho                                  2
## Diego Echavarría                           2
## Doce de Octubre No.2                       2
## El Corazón                                 2
## El Danubio                                 2
## El Diamante                                2
## El Pinal                                   2
## El Poblado                                 2
## El Progreso No.2                           2
## El Rodeo                                   2
## El Salado                                  2
## El Salvador                                2
## El Tesoro                                  2
## El Velódromo                               2
## Enciso                                     2
## Estación Villa                             2
## Facultad de Minas U. Nacional              2
## Fátima                                     2
## Florida Nueva                              2
## Girardot                                   2
## Granada                                    2
## Granizal                                   2
## Guayabal                                   2
## Héctor Abad Gómez                          2
## Kennedy                                    2
## La Aguacatala                              2
## La Castellana                              2
## La Colina                                  2
## La Cruz                                    2
## La Esperanza                               2
## La Floresta                                2
## La Francia                                 2
## La Gloria                                  2
## La Isla                                    2
## La Libertad                                2
## La Milagrosa                               2
## La mota                                    2
## La Piñuela                                 2
## La Pradera                                 2
## La Rosa                                    2
## La Salle                                   2
## Las Acacias                                2
## Las Brisas                                 2
## Las Esmeraldas                             2
## Las Granjas                                2
## Las Palmas                                 2
## Las Violetas                               2
## Lorena                                     2
## Loreto                                     2
## Los Alcázares                              2
## Los Alpes                                  2
## Los Balsos No.1                            2
## Los Cerros El Vergel                       2
## Los Colores                                2
## Los Conquistadores                         2
## Los Mangos                                 2
## Los Pinos                                  2
## Manrique Central No. 1                     2
## Manrique Central No. 2                     2
## Manrique Oriental                          2
## Media Luna                                 2
## Miraflores                                 2
## Miranda                                    2
## Moravia                                    2
## Naranjal                                   2
## Nueva Villa de Aburrá                      2
## Nuevos Conquistadores                      2
## Olaya Herrera                              2
## Pablo VI                                   2
## Palermo                                    2
## Parque Juan Pablo II                       2
## Parque Norte                               2
## Patio Bonito                               2
## Pedregal                                   2
## Playón de Los Comuneros                    2
## Plaza de Ferias                            2
## Robledo                                    2
## Rosales                                    2
## San Bernardo                               2
## San Germán                                 2
## San Isidro                                 2
## San Javier No.1                            2
## San Joaquín                                2
## San Lucas                                  2
## San Miguel                                 2
## San Pedro                                  2
## Santa Cruz                                 2
## Santa Inés                                 2
## Santa Lucía                                2
## Santa María de los Ángeles                 2
## Santa Mónica                               2
## Santander                                  2
## Santo Domingo Savio No. 1                  2
## Sevilla                                    2
## Simón Bolívar                              2
## Suburbano Altavista                        2
## Sucre                                      2
## Suramericana                               2
## Tejelo                                     2
## Tenche                                     2
## Terminal de Transporte                     2
## Toscana                                    2
## Tricentenario                              2
## Trinidad                                   2
## U.D. Atanasio Girardot                     2
## U.P.B.                                     2
## Universidad de Antioquia                   2
## Universidad Nacional                       2
## Veinte de Julio                            2
## Versalles No. 1                            2
## Villa Carlota                              2
## Villa del Socorro                          2
## Villa Guadalupe                            2
## Villa Niza                                 2
## Villatina                                  2

## Cuarto grupo
barrios_mean2[barrios_mean2$grupo == 3,]

##                                          Atropello_HERIDO Choque_HERIDO
## Aures No. 2                                     15.000000     19.600000
## Aures No.1                                      14.400000     21.200000
## Barrio Cristóbal                                 2.200000      9.800000
## Bello Horizonte                                  8.600000     16.200000
## Bermejal-Los Alamos                              9.400000      8.400000
## Blanquizal                                       2.200000      2.500000
## Bomboná No. 2                                    7.200000     12.400000
## Boyacá                                          10.000000     21.200000
## Calasanz Parte Alta                              5.200000     25.200000
## Córdoba                                          9.800000     21.400000
## Doce de Octubre No.1                            22.800000     24.600000
## El Castillo                                      3.000000     12.200000
## El Compromiso                                    7.000000      6.400000
## El Estadio                                      15.800000     42.400000
## El Pomar                                        12.800000     22.200000
## El Progreso                                     18.800000     90.200000
## El Raizal                                       16.000000     15.800000
## El Rincón                                       18.800000     34.200000
## Facultad Veterinaria y Zootecnia U.de.A.         2.000000      5.800000
## Florencia                                        7.800000     16.000000
## Fuente Clara                                     2.600000      9.400000
## Jardín Botánico                                  4.600000      9.800000
## La Alpujarra                                     6.400000     38.400000
## La América                                      22.400000     47.000000
## La Florida                                       7.600000     30.400000
## La Palma                                         8.200000     24.000000
## La Pilarica                                     10.200000     49.600000
## Las Playas                                       4.600000     25.800000
## Loma de los Bernal                               5.800000     18.800000
## López de Mesa                                    4.400000      6.600000
## Los Ángeles                                     17.400000     64.600000
## María Cano Carambolas                            6.000000      1.600000
## Moscú No. 2                                     18.800000      8.200000
## Nueva Villa de la Iguaná                        10.400000     26.800000
## Oriente                                          2.800000      1.666667
## Pedregal Alto                                    2.666667      2.000000
## Picacho                                         28.200000     29.400000
## Piedras Blancas                                  8.400000      4.600000
## Popular                                         26.000000     11.800000
## San Javier No.2                                 11.400000      9.400000
## Santa Margarita                                  3.600000      9.000000
## Santo Domingo Savio No. 2                        6.600000      2.666667
## Suburbano La Loma                                4.800000     10.200000
## Villa Hermosa                                   19.200000     27.400000
##                                          Choque_SOLO DAÑOS Choque_MUERTO
## Aures No. 2                                      24.600000             0
## Aures No.1                                       20.000000             0
## Barrio Cristóbal                                 12.000000             0
## Bello Horizonte                                  20.200000             0
## Bermejal-Los Alamos                              11.800000             0
## Blanquizal                                        4.000000             0
## Bomboná No. 2                                    26.800000             0
## Boyacá                                           35.200000             0
## Calasanz Parte Alta                              45.000000             0
## Córdoba                                          32.000000             0
## Doce de Octubre No.1                             22.000000             0
## El Castillo                                      42.800000             0
## El Compromiso                                     6.400000             0
## El Estadio                                       84.800000             0
## El Pomar                                         15.800000             0
## El Progreso                                     156.200000             0
## El Raizal                                        20.600000             0
## El Rincón                                        78.400000             0
## Facultad Veterinaria y Zootecnia U.de.A.          8.000000             0
## Florencia                                        18.400000             0
## Fuente Clara                                      4.000000             0
## Jardín Botánico                                  24.600000             0
## La Alpujarra                                     96.000000             0
## La América                                      104.000000             0
## La Florida                                      128.000000             0
## La Palma                                         48.800000             0
## La Pilarica                                      82.200000             0
## Las Playas                                       38.800000             0
## Loma de los Bernal                               50.600000             0
## López de Mesa                                    12.200000             0
## Los Ángeles                                      89.400000             0
## María Cano Carambolas                             2.750000             0
## Moscú No. 2                                      10.600000             0
## Nueva Villa de la Iguaná                         35.200000             0
## Oriente                                           1.666667             0
## Pedregal Alto                                     3.250000             0
## Picacho                                          35.800000             0
## Piedras Blancas                                   6.200000             0
## Popular                                          21.400000             0
## San Javier No.2                                  18.600000             0
## Santa Margarita                                   8.600000             0
## Santo Domingo Savio No. 2                         2.800000             0
## Suburbano La Loma                                17.400000             0
## Villa Hermosa                                    29.000000             0
##                                          Atropello_MUERTO Tasa_Choque_HERIDO
## Aures No. 2                                      1.000000          0.4434389
## Aures No.1                                       1.000000          0.5145631
## Barrio Cristóbal                                 1.000000          0.4495413
## Bello Horizonte                                  1.000000          0.4450549
## Bermejal-Los Alamos                              1.500000          0.4158416
## Blanquizal                                       1.000000          0.4166667
## Bomboná No. 2                                    1.000000          0.3163265
## Boyacá                                           1.000000          0.3758865
## Calasanz Parte Alta                              1.000000          0.3589744
## Córdoba                                          1.000000          0.4007491
## Doce de Octubre No.1                             1.200000          0.5278970
## El Castillo                                      1.000000          0.2218182
## El Compromiso                                    1.000000          0.5000000
## El Estadio                                       1.000000          0.3333333
## El Pomar                                         1.000000          0.5842105
## El Progreso                                      1.000000          0.3660714
## El Raizal                                        1.000000          0.4340659
## El Rincón                                        1.000000          0.3037300
## Facultad Veterinaria y Zootecnia U.de.A.         1.000000          0.4202899
## Florencia                                        1.000000          0.4651163
## Fuente Clara                                     1.000000          0.7014925
## Jardín Botánico                                  1.500000          0.2848837
## La Alpujarra                                     1.333333          0.2857143
## La América                                       1.400000          0.3112583
## La Florida                                       1.000000          0.1919192
## La Palma                                         1.000000          0.3296703
## La Pilarica                                      1.000000          0.3763278
## Las Playas                                       1.000000          0.3993808
## Loma de los Bernal                               1.000000          0.2708934
## López de Mesa                                    1.000000          0.3510638
## Los Ángeles                                      1.000000          0.4194805
## María Cano Carambolas                            1.000000          0.4210526
## Moscú No. 2                                      1.000000          0.4361702
## Nueva Villa de la Iguaná                         1.000000          0.4322581
## Oriente                                          1.000000          0.6666667
## Pedregal Alto                                    1.000000          0.4347826
## Picacho                                          1.000000          0.4509202
## Piedras Blancas                                  1.000000          0.4259259
## Popular                                          1.000000          0.3554217
## San Javier No.2                                  1.000000          0.3357143
## Santa Margarita                                  1.000000          0.5113636
## Santo Domingo Savio No. 2                        1.000000          0.6060606
## Suburbano La Loma                                1.000000          0.3695652
## Villa Hermosa                                    1.000000          0.4858156
##                                          Tasa_Choque_MUERTO
## Aures No. 2                                               0
## Aures No.1                                                0
## Barrio Cristóbal                                          0
## Bello Horizonte                                           0
## Bermejal-Los Alamos                                       0
## Blanquizal                                                0
## Bomboná No. 2                                             0
## Boyacá                                                    0
## Calasanz Parte Alta                                       0
## Córdoba                                                   0
## Doce de Octubre No.1                                      0
## El Castillo                                               0
## El Compromiso                                             0
## El Estadio                                                0
## El Pomar                                                  0
## El Progreso                                               0
## El Raizal                                                 0
## El Rincón                                                 0
## Facultad Veterinaria y Zootecnia U.de.A.                  0
## Florencia                                                 0
## Fuente Clara                                              0
## Jardín Botánico                                           0
## La Alpujarra                                              0
## La América                                                0
## La Florida                                                0
## La Palma                                                  0
## La Pilarica                                               0
## Las Playas                                                0
## Loma de los Bernal                                        0
## López de Mesa                                             0
## Los Ángeles                                               0
## María Cano Carambolas                                     0
## Moscú No. 2                                               0
## Nueva Villa de la Iguaná                                  0
## Oriente                                                   0
## Pedregal Alto                                             0
## Picacho                                                   0
## Piedras Blancas                                           0
## Popular                                                   0
## San Javier No.2                                           0
## Santa Margarita                                           0
## Santo Domingo Savio No. 2                                 0
## Suburbano La Loma                                         0
## Villa Hermosa                                             0
##                                          Tasa_Atropello_MUERTO grupo
## Aures No. 2                                         0.06578947     3
## Aures No.1                                          0.06666667     3
## Barrio Cristóbal                                    0.41666667     3
## Bello Horizonte                                     0.11363636     3
## Bermejal-Los Alamos                                 0.15000000     3
## Blanquizal                                          0.41666667     3
## Bomboná No. 2                                       0.13513514     3
## Boyacá                                              0.09803922     3
## Calasanz Parte Alta                                 0.18518519     3
## Córdoba                                             0.09803922     3
## Doce de Octubre No.1                                0.05000000     3
## El Castillo                                         0.35714286     3
## El Compromiso                                       0.13513514     3
## El Estadio                                          0.06250000     3
## El Pomar                                            0.07692308     3
## El Progreso                                         0.05208333     3
## El Raizal                                           0.06024096     3
## El Rincón                                           0.05263158     3
## Facultad Veterinaria y Zootecnia U.de.A.            0.45454545     3
## Florencia                                           0.12500000     3
## Fuente Clara                                        0.35714286     3
## Jardín Botánico                                     0.28846154     3
## La Alpujarra                                        0.18518519     3
## La América                                          0.05882353     3
## La Florida                                          0.12820513     3
## La Palma                                            0.11627907     3
## La Pilarica                                         0.09615385     3
## Las Playas                                          0.20000000     3
## Loma de los Bernal                                  0.16666667     3
## López de Mesa                                       0.21739130     3
## Los Ángeles                                         0.05681818     3
## María Cano Carambolas                               0.16129032     3
## Moscú No. 2                                         0.05263158     3
## Nueva Villa de la Iguaná                            0.09433962     3
## Oriente                                             0.33333333     3
## Pedregal Alto                                       0.33333333     3
## Picacho                                             0.03496503     3
## Piedras Blancas                                     0.11627907     3
## Popular                                             0.03816794     3
## San Javier No.2                                     0.08620690     3
## Santa Margarita                                     0.26315789     3
## Santo Domingo Savio No. 2                           0.14285714     3
## Suburbano La Loma                                   0.17857143     3
## Villa Hermosa                                       0.05154639     3

Los grupos que tienen la etiqueta 1 y 2 parecen estar bien conformados. En ambos casos existen barrios con alta y baja accidentalidad, pero hay diferencias en las tasas de la gravedad originada por un accidente. El grupo con la etiqueta 3 son barrios con baja accidentalidad y bajas tasas en la gravedad del accidente. En este grupo se incluirán los datos provenientes del grupo 0 que tienen baja accidentalidad y baja tasa de gravedad.

se ha identificado en el grupo 0 ciertos barrios que tienen bajos índices de accidentalidad y altas tasas de fatalidad, por lo que se ha decidido agrupar a todos aquellos barrios con menos de 50 accidentes en choque solo daños y donde alguno de sus tasas de fatalidad sea superior a 0.4.

barrios_mean2$grupo[barrios_mean2$grupo == 0 & (barrios_mean2$Tasa_Atropello_MUERTO > 0.4 | barrios_mean2$Tasa_Choque_MUERTO > 0.4)] <- 4
table(barrios_mean2$grupo)

## 
##   0   1   2   3   4 
##  22  82 151  44   9

Los barrios que tienen baja accidentalidad y tasas de fatalidad promedio serán incluidos en el grupo 2.

barrios_mean2$grupo[barrios_mean2$grupo == 0 & barrios_mean2$`Choque_SOLO DAÑOS` < 50] <- 2
table(barrios_mean2$grupo)

## 
##   0   1   2   3   4 
##  20  82 153  44   9

Los otros 20 casos presentes en el grupo 0 son casos en los que la accidentalidad es muy alta en cuanto a choques o que el ratio de heridos o muertos por choque es muy alta para la cantidad de accidentes que se dan en ese barrio, por esta razón se conserva esta configuración.

Ahora con estos grupos apróximadamente homógeneos, se asignan etiquetas:

• Grupo 0: Alta accidentalidad y alto ratio de accidentes con heridos o muertos.
• Grupo 1: Baja o media accidentalidad pero sin fatalidades.
• Grupo 2: Barrios con estadísticas promedio en cuanto tasas de fatalidad, heridos y ratio entre accidentes y personas heridas/muertas.
• Grupo 3: Baja o media accidentalidad con alta tasa de heridos pero sin fatalidades en choques.
• Grupo 4: Baja accidentalidad con alta tasa de fatalidad.

Acá nos referimos a ratio a la relación entre la cantidad de accidentes que no involucran heridos o muertos versus la cantidad de accidentes que involucran heridos o muertos.

De acuerdo a estas etiquetas se procede a graficar el mapa y proseguir con el análisis pertinente.

barrios_mean2$etiqueta[barrios_mean2$grupo == 0] <- "Alta accidentalidad y ratio de heridos/muertos"
barrios_mean2$etiqueta[barrios_mean2$grupo == 1] <- "Baja o media accidentalidad, sin fatalidades"
barrios_mean2$etiqueta[barrios_mean2$grupo == 2] <- "Barrios con estadísticas promedio"
barrios_mean2$etiqueta[barrios_mean2$grupo == 3] <- "Baja o media accidentalidad, alta tasa de heridos"
barrios_mean2$etiqueta[barrios_mean2$grupo == 4] <- "Baja accidentalidad, alta tasa de fatalidad"
barrios_mean2$NOMBRE_BARRIO <- row.names(barrios_mean2)

accidentes_year <- accidentes %>%
  select(NOMBRE_BARRIO,PERIODO) %>%
  group_by(NOMBRE_BARRIO,PERIODO) %>%
  summarize(conteo = n())

## `summarise()` regrouping output by 'NOMBRE_BARRIO' (override with `.groups` argument)

accidentes_total <- accidentes_year %>%
  group_by(NOMBRE_BARRIO) %>%
  summarize(conteo_mean = mean(conteo))

## `summarise()` ungrouping output (override with `.groups` argument)

accidentes_total$conteo_mean <- round(accidentes_total$conteo_mean)
barrios_mean2 <- merge(barrios_mean2,accidentes_total,by="NOMBRE_BARRIO",all.x=TRUE)
barrios_mean2$tasa_fatal_med <- (barrios_mean2$Tasa_Choque_MUERTO + barrios_mean2$Tasa_Atropello_MUERTO)/2

## Copia del spatial data frame
barrios_med_mapa <- barrios_medellin

## Sacar index para organizar luego los registros
barrios_med_mapa@data$index <- as.integer(row.names(barrios_med_mapa@data))

## Combinar el indicador con el data frame spatial para graficar en mapa
barrios_med_mapa@data <- merge(barrios_med_mapa@data,barrios_mean2,by = "NOMBRE_BARRIO",all.x=TRUE)
barrios_med_mapa@data <- barrios_med_mapa@data %>% arrange(index)
barrios_med_mapa@data$grupo <- barrios_med_mapa@data$grupo + 1

Mapa

labels <- sprintf(
  "<strong>%s</strong><br/><strong>Grupo:</strong> <u>%s</u><br/><strong>%g</strong> accidentes promedio por año<br/><strong>%g</strong> accidentes que involucran heridos por año<br/><strong>%g</strong>&#37 de accidentes promedio con al menos un muerto",
  barrios_med_mapa@data$NOMBRE_BARRIO, 
  barrios_med_mapa@data$etiqueta, 
  barrios_med_mapa@data$conteo_mean, round(barrios_med_mapa@data$Atropello_HERIDO + barrios_med_mapa@data$Choque_HERIDO), round(barrios_med_mapa@data$tasa_fatal_med * 100,1)
) %>% lapply(htmltools::HTML)

pal <- colorFactor(palette = c("#04258C","#CEF8FA","#85D0F0","#305FC2","#9B90E1"), 
               levels = c("Alta accidentalidad y ratio de heridos/muertos", "Baja o media accidentalidad, sin fatalidades", "Barrios con estadísticas promedio",
                          "Baja o media accidentalidad, alta tasa de heridos","Baja accidentalidad, alta tasa de fatalidad"))

leaflet(barrios_med_mapa)%>% 
  addTiles()  %>% 
  setView(lat=6.247612, lng=-75.582932, zoom=11.5) %>%
  addPolygons(color="#B4B3B6",weight = 1, fillOpacity = 0.9,opacity = 1, smoothFactor = 0.7, fillColor = ~pal(etiqueta),
  highlight = highlightOptions(
    weight = 3,
    color = "#666",
    fillOpacity = 0.8,
    bringToFront = TRUE),
  label = labels,
  labelOptions = labelOptions(
    style = list("font-weight" = "normal", padding = "3px 8px"),
    textsize = "13px",
    direction = "auto")) %>% 
  addLegend(pal = pal, values = ~etiqueta, opacity = 0.7, title = "Grupo",
            position = "topright")

Planes de Acción.

Partiendo de la base del agrupamiento, se tienen dos tipos de entornos con alta accidentalidad:

1. Avenida regional sentido Norte-Sur a la altura del barrio Santa Fé hasta el barrio Cristo Rey.

Esta zona forma parte de la vía vertebra más importante de Medellín. Es una avenida de 4 carriles continuos, pensados para mantener una velocidad promedio de 80km, sin embargo por las condiciones de incremento del parque automotor del valle de Aburrá, es una vía que en horas pico, la velocidad no se acerca a establecida. Además, es la vía usada por la mayoría de transporte pesado para atravesar la ciudad y transportar mercancías hacia el sur del País; razón por la cual se mantiene una constante exposición de este tipo de vehículos con motos y automóbiles pequeños. Dada esta condición, se parte de una situación desfaborable para quienes toman esta ruta en vehículos de talla menor, especialmente las motos. Plan de acción: Destinar carril exclusivo para el transporte pesado y reestrición de carriles a orillas del río para motos.

2. Avenida Guayabal altura Cristo Rey.

La Avenida Guayabal a la altura de la Calle 4 Sur, es otro de los puntos con alta intesidad en la accidentalidad de los barrios Cristo Rey-Santa Fé. Como puede observarse en la imagen adjunta, es una zona que cuenta con costados comerciales y que aún así la recorren 4 carrilles en donde el promedio de velocidad es considerable. El hecho que sus alrededores estén sujetos a una constante entrada y salida de vehículos, puede provocar que el flujo de tráfico se vea estropeado y así el riesgo de accidentalidad sea alto. Plan de acción: cercamiento del costado de la vía en los puntos donde se alcanza mayor velocidad en el tráfico.

3. Zona centro de la ciudad, comenzando en Perpetuo Socorro-San Diego, hasta Prado.

(Barrio Colón)

(Centro de Medellín San Antonio-Avenida Oriental)

En comparación con el caso anterior, es la zona con más afluencia de personas, también en torno a la cual se reúne el mayor centro de comercio de la ciudad. Como puede verse en las imágenes, son sectores que cuenta con una señalización víal bien definida, sumándole el hecho de la amplitud de los carriles. Partiendo de esto, ¿qué puede explicar la accidentalidad en esta zona, sabiendo que en su mayoría está muy bien señalizada? Los peatones son clave para explicar la accidentalidad en este sector. Dada la gran afluencia de personas en esta parte de la ciudad, es muy común que el peatón se convierta en la mayor amenaza para la accidentalidad, ya no es la velocidad como en los casos citados anteriormente. Plan de acción: ampliación de las aceras en la vía de mayor fluidez de vehículos: la avenida oriental desde la calle 41 hasta la calle 57; regulación estricta de paraderos y zonas de taxis a través del diseño de zonas de bahías con mayor capacidad de albergamiento de vehículos de recogida de pasajeros.

Modelamiento.

En esta sección vamos a generar distintos modelos que predigan la cantidad de accidentes que van a ocurrir en el tiempo con base en una serie de características y teniendo en cuenta que el objetivo principal es predicir el número de accidentes por cada tipo de accidente que se puede presentar.

La predicción se debe realizar a nivel diario, semanal y mensual. Se disponen de los datos desde el 2014 hasta el 2017 para el entrenamiento del modelo y el 2018 para validar los modelos acá realizados.

La idea es realizar una predicción o un pronóstico de la cantidad de accidentes que ocurren por cada uno de los barrios en el tiempo. Por esto, es necesario generar un conjunto de datos en el cual se tenga en cuenta la cantidad de accidentes por barrio. En este sentido, se usan dos conjuntos de datos. El primero tendrá toda la información por días con respecto a días especiales, y el segundo tendrá los indicadores de accidentalidad por barrio. Para más detalle de este procedimiento revisar el markdown prediccion_modelo

Los indicadores de accidentalidad que tendremos en cuenta son:

1. Atropellos.
2. Choques.
3. Otros (que unen caida ocupante, volcamientos y otro).

Estos indicadores se obtuvieron de acuerdo a su ocurrencia y su importancia. Con base en los resultados encontrados en el agrupamiento, se identificó que los choques y los atropellos son indicadores importantes que ayudan a definir la tendencia de accidentalidad en cada uno de los barrios. En el caso del indicador de otros, se agruparon las demás estadísticas de accidentalidad, ya que algunos de estos otros indicadores tenían poca ocurrencia.

Después de alistar los conjuntos de datos y unirlos en uno solo, se obtiene el siguiente conjunto de datos.

## Leer datos formato uno
urlfile_m <- "https://raw.githubusercontent.com/jdgallegoq/analitica_predictiva/master/Reporte/accidentes_barrios_dias_F1.csv"
accidentes_final <- read.csv(urlfile_m, fileEncoding = "ISO-8859-1")

#accidentes_final <- read.csv("accidentes_barrios_dias_F1.csv",fileEncoding = "ISO-8859-1")
head(accidentes_final)

##        FECHA PRECIPITACION_PROM SEMANA_SANTA VAC_MITAD_ANO FERIA_FLORES
## 1 2014-01-01                  0            0             0            0
## 2 2014-01-01                  0            0             0            0
## 3 2014-01-01                  0            0             0            0
## 4 2014-01-01                  0            0             0            0
## 5 2014-01-01                  0            0             0            0
## 6 2014-01-01                  0            0             0            0
##   VAC_DICIEMBRE PERIODO   MES DIA_NOMBRE DIA_MUJER DIA_MADRE. DIA_ID FESTIVO
## 1             0    2014 enero  miércoles         0          0      1       1
## 2             0    2014 enero  miércoles         0          0      1       1
## 3             0    2014 enero  miércoles         0          0      1       1
## 4             0    2014 enero  miércoles         0          0      1       1
## 5             0    2014 enero  miércoles         0          0      1       1
## 6             0    2014 enero  miércoles         0          0      1       1
##          NOMBRE_BARRIO Choque Atropello Otro
## 1 Alejandro Echavarría      1         0    0
## 2              Kennedy      1         0    1
## 3             Altamira      0         0    0
## 4               Boyacá      0         0    0
## 5               Loreto      0         0    0
## 6            Altavista      0         1    0

Este conjunto de datos tiene cada variable de respuesta (Atropello, Choque y Otro) en columnas separadas. La información de los registros y las demás columnas son las características de ese día en específico con cada barrio.

De acuerdo a lo identficado en el markdown con el procedimiento completo, se identificaron algunas variables que no eran relevantes en la identificación de la accidentalidad por barrio. Esta identificación se realizó a través del uso de un bosque aleatorio sobre un conjunto que no incluía los barrios por temas de capacidad computacional.

En la siguiente ejecución se remueven las variables que se identificaron como poco relevantes y se realizan dos procesos adicionales para que el conjunto de datos quede listo para el modelamiento:

accidentes_final <- accidentes_final %>%
  select(-VAC_MITAD_ANO,-VAC_DICIEMBRE)

## Variable día mes
accidentes_final$DIA_ID <- as.numeric(gsub(".+(..)$","\\1",accidentes_final$FECHA))
print(summary(accidentes_final$DIA_ID))

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    8.00   16.00   15.73   23.00   31.00

## Se eliminan caracteres propios del español
accidentes_final$NOMBRE_BARRIO <- stringi::stri_trans_general(accidentes_final$NOMBRE_BARRIO,id="LATIN-ASCII")
accidentes_final$DIA_NOMBRE <- stringi::stri_trans_general(accidentes_final$DIA_NOMBRE,id="LATIN-ASCII")

head(accidentes_final)

##        FECHA PRECIPITACION_PROM SEMANA_SANTA FERIA_FLORES PERIODO   MES
## 1 2014-01-01                  0            0            0    2014 enero
## 2 2014-01-01                  0            0            0    2014 enero
## 3 2014-01-01                  0            0            0    2014 enero
## 4 2014-01-01                  0            0            0    2014 enero
## 5 2014-01-01                  0            0            0    2014 enero
## 6 2014-01-01                  0            0            0    2014 enero
##   DIA_NOMBRE DIA_MUJER DIA_MADRE. DIA_ID FESTIVO        NOMBRE_BARRIO Choque
## 1  miercoles         0          0      1       1 Alejandro Echavarria      1
## 2  miercoles         0          0      1       1              Kennedy      1
## 3  miercoles         0          0      1       1             Altamira      0
## 4  miercoles         0          0      1       1               Boyaca      0
## 5  miercoles         0          0      1       1               Loreto      0
## 6  miercoles         0          0      1       1            Altavista      0
##   Atropello Otro
## 1         0    0
## 2         0    1
## 3         0    0
## 4         0    0
## 5         0    0
## 6         1    0

En la anterior ejecución, se adicionó la variable con el identificativo del día en el mes, es decir el número del día de 1 hasta 31 en los casos que aplica. Así mismo, dado que muchos de los algoritmos probados no admiten caracteres diferentes a los del alfabeto inglés, fue necesario remover tildes y ñ de las variables que contenían estos caracteres para evitar problemas en el ajuste de los modelos.

Así mismo, se divide el conjunto de datos en entrenamiento y validación, teniendo en cuenta los lineamientos del proyecto.

## Separar conjuntos de datos
accidentes_final_train <- accidentes_final %>%
  filter(PERIODO != 2018)
print(nrow(accidentes_final_train))

## [1] 449988

accidentes_final_val <- accidentes_final %>%
  filter(PERIODO == 2018) 
print(nrow(accidentes_final_val))

## [1] 112420

En este punto, se debe aclarar que detrás del reporte formal que representa este documento, hemos realizado modelos para cada una de las 3 variables de respuesta con las siguientes técnicas:

• Regresión lineal.
• Regresión log-lin.
• Regresión de Poisson.
• Regresión binomial negativa.
• Redes neuronales.
• Regresión dinámica (modelando residuales con ARIMA).
• Árboles de regresión.

En este reporte se aborda el enfoque final utilizado por el equipo de trabajo en la predicción, ya que es el que presenta mejores resultados en la métrica de error cuadrático medio. Durante la ejecución de las demás técnicas se apreció una dificultad para poder predecir la accidentalidad (en especial en los indicadores de atropellos y otros) ya que los indicadores presentaban una gran cantidad de 0 y la mayoría de técnicas usadas en la regresión estimaban valores en un espacio continuo. Así mismo, la cantidad de valores en accidentes en cada día era reducida. A pesar de que el árbol fue el mejor modelo, la reducción del MSE no es tan drástica como se podría pensar, pero lo suficiente para ser escogido.

Predicción con árboles de regresión

Retomando lo dicho, se utilizan los datos ya mencionados, que contienen alrededor de 500k registros con tres variables de respuesta, una para cada indicador definido en el proyecto. Estos indicadores son:

• Número de choques de vehículos.
• Número de accidentes que involucran un atropello de al menos un peatón
• Número de otros accidentes (caída ocupante, volcamiento, incendio, etc.)

La idea con los árboles de regresión radica en la cantidad de datos que tiene 0 y en realidad se tienen pocos valores de la cantidad de accidentes que pueden ocurrir en un día, y al ser una variable discreta, la predicción más acertada es de valores enteros. Una de las grandes ventajas de este modelo es que capaz de trabajar con datos altamente no lineales y dividirlos mediante una serie de reglas que permiten establecer una estimación puntual de cada subconjunto dividido.

Con esta información, se divide el conjunto de datos original en tres conjuntos para entrenamiento y validación. Esto se realiza para evitar problemas con el ajuste del modelo.

En la siguiente sección de código se crean 6 data frames diferentes, ya que inicialmente el modelo estaba arrojando un error por no incluir variables directamente en la fórmula de generación del modelo. Por esta razón, se decidió excluir las variables con las que el modelo estaba generando error.

choque_final_train <- accidentes_final_train %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Atropello,-Otro)

atropello_final_train <- accidentes_final_train %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Choque,-Otro)

otro_final_train <- accidentes_final_train %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Choque,-Atropello)

choque_final_val <- accidentes_final_val %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Atropello,-Otro)

atropello_final_val <- accidentes_final_val %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Choque,-Otro)

otro_final_val <- accidentes_final_val %>%
    select(-DIA_MUJER,-DIA_MADRE.,-PRECIPITACION_PROM,-FECHA,-Choque,-Atropello)

Con estos datos se estiman los árboles de regresión de cada uno de los indicadores.

## Árbol de regresión para choques
tree_choque <- rpart(Choque ~ ., data=choque_final_train, method="anova",control=rpart.control(minsplit=50, cp=0.0001))
#summary(tree_choque)

tree_choque$variable.importance

## NOMBRE_BARRIO    DIA_NOMBRE       FESTIVO           MES       PERIODO 
##  55663.888565   4568.089386   1953.484902    550.461843    228.711820 
##        DIA_ID  FERIA_FLORES  SEMANA_SANTA 
##    187.117167     31.854208      3.657653

y_train_choque <- predict(tree_choque, newdata = choque_final_train)
mse_t_choque <- mean((choque_final_train$Choque - y_train_choque)^2)
print(mse_t_choque)

## [1] 0.2635976

y_val_choque <- predict(tree_choque, newdata = choque_final_val)
mse_tv_choque <- mean((choque_final_val$Choque - y_val_choque)^2)
print(mse_tv_choque)

## [1] 0.2717996

((mse_tv_choque - mse_t_choque)/mse_t_choque)*100

## [1] 3.111565

Esta es la mejor configuración que se obtuvo al probar distintos parámetros para el modelo de choque. Se restalta el intento de realizar optimización de los hiperparámetros del modelo y no fue posible debido al alto costo computacional que este demanda al ser un conjunto de datos grande. Sin embargo, se encontró que este modelo es el que presenta el menor error cuadrático medio tanto en entrenamiento como en validación, razón por la cual se utilizará para las predicciones formales que se realizarán en la aplicación.

Ahora el indicador de atropello.

## Árbol de regresión para atropello
tree_atropello <- rpart(Atropello ~ ., data=atropello_final_train, method="anova",control=rpart.control(minsplit=70, cp=0.0001))
#summary(tree_atropello)

tree_atropello$variable.importance

## NOMBRE_BARRIO    DIA_NOMBRE           MES       PERIODO        DIA_ID 
##  1018.0315930    36.0642327    27.6000248    27.1872424    18.8013094 
##       FESTIVO  SEMANA_SANTA  FERIA_FLORES 
##     4.9730240     1.4751037     0.9321415

y_train_atropello <- predict(tree_atropello, newdata = atropello_final_train)
mse_t_atropello <- mean((atropello_final_train$Atropello - y_train_atropello)^2)
print(mse_t_atropello)

## [1] 0.03887768

y_val_atropello <- predict(tree_atropello, newdata = atropello_final_val)
mse_tv_atropello <- mean((atropello_final_val$Atropello - y_val_atropello)^2)
print(mse_tv_atropello)

## [1] 0.03359137

((mse_tv_atropello - mse_t_atropello)/mse_t_atropello)*100

## [1] -13.59729

Si bien este modelo no mejora significativamente las estadísticas de los demás modelos, es uno de los modelos más livianos y fáciles de trabajar debido a su estructura. Además, la forma en la que está diseñado permite más aplicaciones como la generación e identificación de reglas que permiten realizar un agrupamiento adicional de los barrios de la ciudad en cuanto a sus indicadores de accidentalidad. Además tiene un MSE de cambio porcentual menor al de los demás modelos.

Finalmente, el modelo de otros accidentes.

## Árbol de regresión para atropello
tree_otro <- rpart(Otro ~ ., data=otro_final_train, method="anova",control=rpart.control(minsplit=70, cp=0.0001))
#summary(tree_otro)

tree_otro$variable.importance

## NOMBRE_BARRIO    DIA_NOMBRE           MES       FESTIVO       PERIODO 
##  3897.9131694   135.7747810    90.3157992    54.5467830    23.1719714 
##        DIA_ID  FERIA_FLORES  SEMANA_SANTA 
##    14.6560154     4.2656784     0.5377815

y_train_otro <- predict(tree_otro, newdata = otro_final_train)
mse_t_otro <- mean((otro_final_train$Otro - y_train_otro)^2)
print(mse_t_otro)

## [1] 0.08894877

y_val_otro <- predict(tree_otro, newdata = otro_final_val)
mse_tv_otro <- mean((otro_final_val$Otro - y_val_otro)^2)
print(mse_tv_otro)

## [1] 0.07914589

((mse_tv_otro - mse_t_otro)/mse_t_otro)*100

## [1] -11.02082

A diferencia del anterior, en este modelo se puede percibir una mejora en el error cuadrático medio de la validación, por lo que también queda seleccionad como el modelo a utilizar para la predicción de la accidentalidad de otro tipo en la ciudad de Medellín. Los 3 modelos generados cumplen el tema de sobreajuste ya que ninguno supera el 15% de error porcentual entre las métricas de entrenamiento y validación. En este punto es de aclarar, que los modelos de atropello y otros aunque presentan variaciones porcentuales significativas ambas se encuentran por debajo de las métricas de entrenamiento por lo que, en teoría, no se puede hablar de sobreajuste. Lo que parece es que hay un comportamiento un poco diferente en el último año.

Además de lo mencionado, se quiere dejar claro que no se realizó un modelo de bosque aleatorio debido a la alta capacidad computacional que este demenda y al tiempo de ejecución, por lo que se hicieron búsquedas de parámetros para dejar un buen modelo de árbol de regresión.

Como era de esperar en la importancia de las variables, la variable que siempre predomina en la estimación de la cantidad de accidentes en la ciudad es el nombre del barrio. Tal y como se observó en el agrupamiento, los diferentes barrios se agrupan naturalmente con ciertas características en común, donde los barrios con vías principales son más propensos a sufrir mayor cantidad de accidentes.

Para finalizar se deció utilizar las predicciones diarias para estimar la predicción por semana y mes. La forma en la que se procede es realizar las estimaciones diarias para el periodo seleccionado y a continuación sumar los dias necesarios para conformar la semana o el mes elegido, posterior a esto el valor será redondeado al número entero más cercano.

En cuanto a los valores generados por el modelo, se observa que los valores contienen cifras decimales. Sin embargo, se está estimando la cantidad de accidentes que ocurren de cierto tipo en cada barrio. Dado esto, también es necesario generar algún tipo de estrategia para hacer las aproximaciones de las estimaciones a un número entero. Para definir esta estrategia se mira el comportamiento de los valores reales que son diferentes de 0 y las predicciones realizadas, y el comportamiento de los valores reales que fueron 0 y sus respectivas predicciones.

## Revisión de valores en choques
choques_full <- data.frame(choque_final_train$Choque,y_train_choque)

## Vamos a discretizar en rangos los valores predichos
choques_full$ranges <- cut(choques_full$y_train_choque,breaks = 200)

## Agrupar
choques_full_group <- choques_full %>%
  group_by(ranges,choque_final_train.Choque) %>%
  summarize(cuenta = n())

## `summarise()` regrouping output by 'ranges' (override with `.groups` argument)

choques_ranges <- choques_full %>%
  group_by(ranges) %>%
  summarize(cuenta_total = n())

## `summarise()` ungrouping output (override with `.groups` argument)

choques_full_group <- merge(choques_full_group,choques_ranges,by="ranges",all.x=TRUE)
choques_full_group$perc <- choques_full_group$cuenta/choques_full_group$cuenta_total
choques_full_group_f <- choques_full_group %>%
  select(-cuenta,-cuenta_total) %>%
  pivot_wider(values_from="perc",names_from="choque_final_train.Choque",values_fill = 0)

names(choques_full_group_f)[2:13] <- paste("value",names(choques_full_group_f)[2:13],sep="_")
head(choques_full_group_f)

## # A tibble: 6 x 13
##   ranges value_0 value_1 value_2 value_3 value_4 value_5 value_6 value_8 value_7
##   <fct>    <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1 (0.00~   0.989  0.0113 1.91e-4 0.      0.      0.            0       0       0
## 2 (0.05~   0.941  0.0563 2.56e-3 8.78e-5 0.      0.            0       0       0
## 3 (0.09~   0.897  0.0962 6.25e-3 3.16e-4 1.76e-5 0.            0       0       0
## 4 (0.11~   0.882  0.109  8.61e-3 3.19e-4 0.      0.            0       0       0
## 5 (0.16~   0.846  0.139  1.39e-2 8.01e-4 1.28e-4 1.60e-5       0       0       0
## 6 (0.18~   0.820  0.160  1.87e-2 1.01e-3 5.05e-4 0.            0       0       0
## # ... with 3 more variables: value_10 <dbl>, value_9 <dbl>, value_11 <dbl>

## Calculo del valor medio esperado
choques_full_group$medio_range <- choques_full_group$choque_final_train.Choque * choques_full_group$perc
choques_full_group2 <- choques_full_group %>%
  group_by(ranges) %>%
  summarize(medio_range = sum(medio_range))

## `summarise()` ungrouping output (override with `.groups` argument)

fig_choques <- plot_ly(choques_full_group_f, 
                       x = ~ranges, y = ~value_0, type = 'bar', name = 'value_0')
fig_choques <- fig_choques %>% add_trace(y = ~value_1, name = 'value_1')
fig_choques <- fig_choques %>% add_trace(y = ~value_2, name = 'value_2')
fig_choques <- fig_choques %>% add_trace(y = ~value_3, name = 'value_3')
fig_choques <- fig_choques %>% add_trace(y = ~value_4, name = 'value_4')
fig_choques <- fig_choques %>% add_trace(y = ~value_5, name = 'value_5')
fig_choques <- fig_choques %>% add_trace(y = ~value_6, name = 'value_6')
fig_choques <- fig_choques %>% add_trace(y = ~value_7, name = 'value_7')
fig_choques <- fig_choques %>% add_trace(y = ~value_8, name = 'value_8')
fig_choques <- fig_choques %>% add_trace(y = ~value_9, name = 'value_9')
fig_choques <- fig_choques %>% add_trace(y = ~value_10, name = 'value_10')
fig_choques <- fig_choques %>% add_trace(y = ~value_11, name = 'value_11')
fig_choques <- fig_choques %>% layout(yaxis = list(title = 'Count'), barmode = 'stack')

fig_choques

De esta forma, es posible apreciar como se distribuyen los valores en entrenamiento de las respectivas predicciones. Con base en el valor medio esperado, obtenido mediante el porcentaje de valores de cierta cantidad que caen en cierto rango, por lo que se decide aproximar el valor medio de cada rango a su entero más cercano y de acuerdo a los rangos de valores definidos vamos se aproximan los valores que caigan en ese rango al entero definido por el valor medio esperado.

Se realiza el mismo procedimiento para los demás modelos.

## Revisión de valores en atropellos
atropellos_full <- data.frame(atropello_final_train$Atropello,y_train_atropello)

## Vamos a discretizar en rangos los valores predichos
atropellos_full$ranges <- cut(atropellos_full$y_train_atropello,breaks = 200)

## Agrupar
atropellos_full_group <- atropellos_full %>%
  group_by(ranges,atropello_final_train.Atropello) %>%
  summarize(cuenta = n())

## `summarise()` regrouping output by 'ranges' (override with `.groups` argument)

atropellos_ranges <- atropellos_full %>%
  group_by(ranges) %>%
  summarize(cuenta_total = n())

## `summarise()` ungrouping output (override with `.groups` argument)

atropellos_full_group <- merge(atropellos_full_group,atropellos_ranges,by="ranges",all.x=TRUE)
atropellos_full_group$perc <- atropellos_full_group$cuenta/atropellos_full_group$cuenta_total
atropellos_full_group_f <- atropellos_full_group %>%
  select(-cuenta,-cuenta_total) %>%
  pivot_wider(values_from="perc",names_from="atropello_final_train.Atropello",values_fill = 0)

names(atropellos_full_group_f)[2:6] <- paste("value",names(atropellos_full_group_f)[2:6],sep="_")

## Calculo del valor medio esperado
atropellos_full_group$medio_range <- atropellos_full_group$atropello_final_train.Atropello * atropellos_full_group$perc
atropellos_full_group2 <- atropellos_full_group %>%
  group_by(ranges) %>%
  summarize(medio_range = sum(medio_range))

## `summarise()` ungrouping output (override with `.groups` argument)

fig_atropellos <- plot_ly(atropellos_full_group_f, 
                       x = ~ranges, y = ~value_0, type = 'bar', name = 'value_0')
fig_atropellos <- fig_atropellos %>% add_trace(y = ~value_1, name = 'value_1')
fig_atropellos <- fig_atropellos %>% add_trace(y = ~value_2, name = 'value_2')
fig_atropellos <- fig_atropellos %>% add_trace(y = ~value_3, name = 'value_3')
fig_atropellos <- fig_atropellos %>% layout(yaxis = list(title = 'Count'), barmode = 'stack')

fig_atropellos

Se ejecuta el mismo procedimiento descrito con el modelo de otros accidentes.

## Revisión de valores en otros
otros_full <- data.frame(otro_final_train$Otro,y_train_otro)

## Vamos a discretizar en rangos los valores predichos
otros_full$ranges <- cut(otros_full$y_train_otro,breaks = 200)

## Agrupar
otros_full_group <- otros_full %>%
  group_by(ranges,otro_final_train.Otro) %>%
  summarize(cuenta = n())

## `summarise()` regrouping output by 'ranges' (override with `.groups` argument)

otros_ranges <- otros_full %>%
  group_by(ranges) %>%
  summarize(cuenta_total = n())

## `summarise()` ungrouping output (override with `.groups` argument)

otros_full_group <- merge(otros_full_group,otros_ranges,by="ranges",all.x=TRUE)
otros_full_group$perc <- otros_full_group$cuenta/otros_full_group$cuenta_total
otros_full_group_f <- otros_full_group %>%
  select(-cuenta,-cuenta_total) %>%
  pivot_wider(values_from="perc",names_from="otro_final_train.Otro",values_fill = 0)

names(otros_full_group_f)[2:9] <- paste("value",names(otros_full_group_f)[2:9],sep="_")

## Calculo del valor medio esperado
otros_full_group$medio_range <- otros_full_group$otro_final_train.Otro * otros_full_group$perc
otros_full_group2 <- otros_full_group %>%
  group_by(ranges) %>%
  summarize(medio_range = sum(medio_range))

## `summarise()` ungrouping output (override with `.groups` argument)

fig_otros <- plot_ly(otros_full_group_f, 
                       x = ~ranges, y = ~value_0, type = 'bar', name = 'value_0')
fig_otros <- fig_otros %>% add_trace(y = ~value_1, name = 'value_1')
fig_otros <- fig_otros %>% add_trace(y = ~value_2, name = 'value_2')
fig_otros <- fig_otros %>% add_trace(y = ~value_3, name = 'value_3')
fig_otros <- fig_otros %>% add_trace(y = ~value_4, name = 'value_4')
fig_otros <- fig_otros %>% add_trace(y = ~value_5, name = 'value_5')
fig_otros <- fig_otros %>% add_trace(y = ~value_6, name = 'value_6')
fig_otros <- fig_otros %>% add_trace(y = ~value_8, name = 'value_8')
fig_otros <- fig_otros %>% layout(yaxis = list(title = 'Count'), barmode = 'stack')

fig_otros

Cabe recordar que para el caso de valores agrupados como semana o mes vamos a sumar los valores diarios que arroja el modelo y los vamos a sumar para completar la unidad de tiempo requerida (semana, mes) y luego dicho resultado de la suma será redondeado a su valor entero más cercano.

En la siguiente ejecución de código se obtiene el valor entero al que se redondeará cada predicción realizada de acuerdo a lo encontrado en el modelo entrenado.

choques_full_group2$estimado <- round(choques_full_group2$medio_range)
atropellos_full_group2$estimado <- round(atropellos_full_group2$medio_range)
otros_full_group2$estimado <- round(otros_full_group2$medio_range)

Con estos rangos de valores se redondean los resultados del árbol de regresión. Para los casos donde el valor de la estimación exceda el último rango definido se aproxima al valor medio entero del último rango definido.

Se obtienen el valor mínimo y máximo de los intervalos para la comparación.

## Obtener mínimo
extrae_min <- function(x){
  min <- gsub("\\((.+),.+","\\1",x)
  return(min)
}

choques_full_group2$min <- as.numeric(extrae_min(choques_full_group2$ranges))
atropellos_full_group2$min <- as.numeric(extrae_min(atropellos_full_group2$ranges))
otros_full_group2$min <- as.numeric(extrae_min(otros_full_group2$ranges))

## El máximo será el mínimo valor del siguiente intervalo
choques_full_group2$max <- lead(choques_full_group2$min)
atropellos_full_group2$max <- lead(atropellos_full_group2$min)
otros_full_group2$max <- lead(otros_full_group2$min)

## Al registro que tiene NA en el máximo se le asigna un número muy grande, lo que denota
## que todo número mayor a los observados caerá en el último rango
choques_full_group2$max[is.na(choques_full_group2$max)] <- 1000
atropellos_full_group2$max[is.na(atropellos_full_group2$max)] <- 1000
otros_full_group2$max[is.na(otros_full_group2$max)] <- 1000

Finalmente, se almacenan los modelos generados y los datos de aproximación para realizar las predicciones sobre la aplicación diseñada.

Referencias.

Las 20 ciudades más pobladas de Colombia. Libretilla. (2020). Recuperado el 1 de Septiembre, 2020, de: https://libretilla.com/ciudades-mas-grandes-de-colombia-por-poblacion/. Broseta, A., 2020. Mejores Ciudades Para Vivir En Colombia En 2020. Rankia. Recuperado el 1 de Septiembre, 2020, de: https://www.rankia.co/blog/mejores-opiniones-colombia/3120172-mejores-ciudades-para-vivir-colombia-2020 Google. (2019). Calles de Medellín. Recuperado el 1 de Septiembre, 2020, de: https://www.google.com/maps/